home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 2 / ETO Development Tools 2.iso / Tools - Objects / MacApp / MacApp CD Release / MacApp 2.0.1 (Many Libraries) / Libraries / UDialog.inc1.p < prev    next >
Encoding:
Text File  |  1990-10-25  |  93.6 KB  |  3,728 lines  |  [TEXT/MPS ]

  1. {$P}
  2. {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
  3. { UDDialog.inc1.p }
  4. { Copyright © 1988-1990 Apple Computer Inc. All rights reserved. }
  5.  
  6. {--------------------------------------------------------------------------------------------------}
  7. {$S DlgInit}
  8.  
  9. PROCEDURE InitUDialog;
  10.  
  11.     BEGIN
  12.     IF qTemplateViews THEN
  13.         BEGIN
  14.         { So the linker doesn't dead strip these }
  15.         IF gDeadStripSuppression THEN
  16.             BEGIN
  17.             IF Member(TObject(NIL), TDialogView) THEN;
  18.             IF Member(TObject(NIL), TControl) THEN;
  19.             IF Member(TObject(NIL), TButton) THEN;
  20.             IF Member(TObject(NIL), TCheckBox) THEN;
  21.             IF Member(TObject(NIL), TRadio) THEN;
  22.             IF Member(TObject(NIL), TCluster) THEN;
  23.             IF Member(TObject(NIL), TIcon) THEN;
  24.             IF Member(TObject(NIL), TPicture) THEN;
  25.             IF Member(TObject(NIL), TPopup) THEN;
  26.             IF Member(TObject(NIL), TStaticText) THEN;
  27.             IF Member(TObject(NIL), TEditText) THEN;
  28.             IF Member(TObject(NIL), TNumberText) THEN;
  29.             IF Member(TObject(NIL), TPattern) THEN;
  30.             END;
  31.  
  32.         RegisterStdType('TDialogView', kStdDialogView);
  33.         RegisterStdType('TControl', kStdControl);
  34.         RegisterStdType('TButton', kStdButton);
  35.         RegisterStdType('TCheckBox', kStdCheckBox);
  36.         RegisterStdType('TRadio', kStdRadio);
  37.         RegisterStdType('TCluster', kStdCluster);
  38.         RegisterStdType('TIcon', kStdIcon);
  39.         RegisterStdType('TPicture', kStdPicture);
  40.         RegisterStdType('TPopup', kStdPopup);
  41.         RegisterStdType('TStaticText', kStdStaticText);
  42.         RegisterStdType('TEditText', kStdEditText);
  43.         RegisterStdType('TNumberText', kStdNumberText);
  44.         RegisterStdType('TPattern', kStdPattern);
  45.         END;
  46.  
  47.     gUDialogInitialized := TRUE;
  48.     END;
  49.  
  50. {--------------------------------------------------------------------------------------------------}
  51. {$S DlgRes}
  52.  
  53. PROCEDURE GetMenuColors(popupRect: Rect;
  54.                         menuID, itemNum: INTEGER;
  55.                         VAR fColor, bColor: RGBColor);
  56.  
  57.     VAR
  58.         gotTitle:            BOOLEAN;
  59.         gdh:                GDHandle;
  60.         mce:                MCEntryPtr;
  61.         titleMce:            MCEntry;
  62.         globalMce:            MCEntry;
  63.  
  64.     PROCEDURE SetBadColors;
  65.  
  66.         BEGIN
  67.         fColor := gRGBBlack;
  68.         bColor := gRGBWhite;
  69.         END;
  70.  
  71.     BEGIN
  72.     gotTitle := False;                                    { Assume the worst. We always do. }
  73.  
  74.     IF EmptyRect(popupRect) THEN
  75.         SetBadColors                                    { Can't see it anyway so use B&W }
  76.     ELSE IF qNeedsColorQD | gConfiguration.hasColorQD THEN { First, be sure we have color QD… }
  77.         BEGIN
  78.         LocalToGlobal(popupRect.topLeft);                { Globalize rect, in focused coordinates }
  79.         LocalToGlobal(popupRect.botRight);
  80.         gdh := GetMaxDevice(popupRect);                 { Get device characteristics for that rect }
  81.  
  82.         IF (gdh <> NIL) & (gdh^^.gdPMap^^.pixelSize > 1) THEN { If we have more than two colors }
  83.             BEGIN
  84.             mce := GetMCEntry(menuID, 0);                { Always get title entry }
  85.             IF mce <> NIL THEN
  86.                 BEGIN
  87.                 gotTitle := TRUE;
  88.                 titleMce := mce^;                        { Future calls could shift memory }
  89.                 END;
  90.  
  91.             IF NOT gotTitle THEN                        { If we can't get the title entry, then… }
  92.                 BEGIN
  93.                 mce := GetMCEntry(0, 0);                { …we'll need the global entry, too }
  94.                 IF mce <> NIL THEN
  95.                     globalMce := mce^
  96.                 ELSE
  97.                     BEGIN
  98.                     SetBadColors;                        { If no title, AND no global entry, punt }
  99.                     EXIT(GetMenuColors);                { Even if item guy exists. No title, No
  100.                                                          washee }
  101.                     END;
  102.                 END;
  103.  
  104.             { Handle a title color request }
  105.             IF itemNum = 0 THEN
  106.                 BEGIN
  107.                 IF gotTitle THEN
  108.                     BEGIN
  109.                     fColor := titleMce.mctRGB1;
  110.                     bColor := titleMce.mctRGB2;
  111.                     END
  112.                 ELSE                                    { IF gotGlobal << has to be, by this point }
  113.                     BEGIN
  114.                     fColor := globalMce.mctRGB1;
  115.                     bColor := globalMce.mctRGB4;
  116.                     END;
  117.                 END
  118.                 { Otherwise, it's for an item }
  119.             ELSE
  120.                 BEGIN
  121.                 mce := GetMCEntry(menuID, itemNum);
  122.                 IF mce <> NIL THEN
  123.                     fColor := mce^.mctRGB2
  124.                 ELSE IF gotTitle THEN
  125.                     fColor := titleMce.mctRGB3
  126.                 ELSE
  127.                     fColor := globalMce.mctRGB3;
  128.  
  129.                 IF gotTitle THEN
  130.                     bColor := titleMce.mctRGB4
  131.                 ELSE
  132.                     bColor := globalMce.mctRGB2;
  133.                 END;
  134.             END
  135.         ELSE
  136.             SetBadColors;                                { Only one bit depth. Default to B&W }
  137.         END
  138.     ELSE
  139.         SetBadColors;                                    { Not using Color QuickDraw. B&W for sure }
  140.  
  141.     {$IFC qDebug}
  142.     IF gIntenseDebugging THEN
  143.         BEGIN
  144.         IF itemNum = 0 THEN
  145.             WRITE('Title ')
  146.         ELSE
  147.             WRITE('Item #', itemNum: 0);
  148.         WRITELN(' foreground color- R:', fColor.red: 0, ', G:', fColor.green: 0, ', B:',
  149.                 fColor.blue: 0);
  150.         IF itemNum = 0 THEN
  151.             WRITE('Title ')
  152.         ELSE
  153.             WRITE('Item #', itemNum: 0);
  154.         WRITELN(' background color- R:', bColor.red: 0, ', G:', bColor.green: 0, ', B:',
  155.                 bColor.blue: 0);
  156.         END;
  157.     {$ENDC}
  158.     END;
  159.  
  160. {--------------------------------------------------------------------------------------------------}
  161. {$S DlgOpen}
  162.  
  163. PROCEDURE TDialogView.IDialogView(itsDocument: TDocument;
  164.                                   itsSuperView: TView;
  165.                                   itsLocation, itsSize: VPoint;
  166.                                   itsHSizeDet, itsVSizeDet: SizeDeterminer;
  167.                                   itsDefItemID, itsCancelItemID: IDType);
  168.  
  169.     VAR
  170.         anAssociation:        TAssociation;
  171.         fi:                 FailInfo;
  172.  
  173.     PROCEDURE HandleFailure(error: OSErr;
  174.                             message: LONGINT);
  175.  
  176.         BEGIN
  177.         Free;
  178.         END;
  179.  
  180.     BEGIN
  181.     {$IFC qDebug}
  182.     IF NOT gUDialogInitialized THEN
  183.         BEGIN
  184.         ProgramBreak('InitUDialog must be called before creating a Dialog View.');
  185.         Failure(noErr, 0);
  186.         END;
  187.     {$ENDC}
  188.  
  189.     fParamTxt := NIL;                                    { In case of a catastrophe }
  190.     fTEView := NIL;                                     { Ditto. }
  191.     IView(itsDocument, itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  192.  
  193.     CatchFailures(fi, HandleFailure);
  194.     New(anAssociation);                                 { Okay to allocate list now }
  195.     FailNIL(anAssociation);
  196.     anAssociation.IAssociation;
  197.     fParamTxt := anAssociation;
  198.     fDefaultItem := itsDefItemID;
  199.     fCancelItem := itsCancelItemID;
  200.     fCurrentEditText := NIL;
  201.     fDismissed := False;
  202.     fDismisser := kNoIdentifier;
  203.  
  204.     fTEView := MakeTEView;
  205.     Success(fi);
  206.     END;
  207.  
  208. {--------------------------------------------------------------------------------------------------}
  209. {$S DlgOpen}
  210.  
  211. PROCEDURE TDialogView.IRes(itsDocument: TDocument;
  212.                            itsSuperView: TView;
  213.                            VAR itsParams: Ptr); OVERRIDE;
  214.  
  215.     VAR
  216.         anAssociation:        TAssociation;
  217.         fi:                 FailInfo;
  218.  
  219.     PROCEDURE HandleFailure(error: OSErr;
  220.                             message: LONGINT);
  221.  
  222.         BEGIN
  223.         Free;
  224.         END;
  225.  
  226.     BEGIN
  227.     {$IFC qDebug}
  228.     IF NOT gUDialogInitialized THEN
  229.         BEGIN
  230.         ProgramBreak('InitUDialog must be called before creating a Dialog View.');
  231.         Failure(noErr, 0);
  232.         END;
  233.     {$ENDC}
  234.  
  235.     fParamTxt := NIL;                                    { In case of a catastrophe }
  236.     fTEView := NIL;                                     { Ditto. }
  237.     INHERITED IRes(itsDocument, itsSuperView, itsParams);
  238.     WITH DialogViewTemplatePtr(itsParams)^ DO
  239.         BEGIN
  240.         fDefaultItem := defaultItem;
  241.         fCancelItem := cancelItem;
  242.         END;
  243.     CatchFailures(fi, HandleFailure);
  244.     New(anAssociation);                                 { Okay to allocate list now }
  245.     FailNIL(anAssociation);
  246.     anAssociation.IAssociation;
  247.     fParamTxt := anAssociation;
  248.     fCurrentEditText := NIL;
  249.     fDismissed := False;
  250.     fDismisser := kNoIdentifier;
  251.  
  252.     fTEView := MakeTEView;
  253.     Success(fi);
  254.  
  255.     OffsetPtr(itsParams, SIZEOF(DialogViewTemplate));
  256.     END;
  257.  
  258. {--------------------------------------------------------------------------------------------------}
  259. {$S MAWriteRes}
  260.  
  261. PROCEDURE TDialogView.WRes(theResource: ViewRsrcHndl;
  262.                            VAR itsParams: Ptr); OVERRIDE;
  263.  
  264.     VAR
  265.         dgPtr:                DialogViewTemplatePtr;
  266.  
  267.     BEGIN
  268.     INHERITED WRes(theResource, itsParams);
  269.  
  270.     dgPtr := DialogViewTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(DialogViewTemplate)));
  271.  
  272.     WITH dgPtr^ DO
  273.         BEGIN
  274.         defaultItem := fDefaultItem;
  275.         cancelItem := fCancelItem;
  276.         END;
  277.     END;
  278.  
  279. {--------------------------------------------------------------------------------------------------}
  280. {$S MAWriteRes}
  281.  
  282. PROCEDURE TDialogView.WriteRes(theResource: ViewRsrcHndl;
  283.                                VAR itsParams: Ptr); OVERRIDE;
  284.  
  285.     BEGIN
  286.     gWResSignature := 'dlog'; gWResType := 'TDialogView';
  287.     WRes(theResource, itsParams);
  288.     END;
  289.  
  290. {--------------------------------------------------------------------------------------------------}
  291. {$S DlgClose}
  292.  
  293. PROCEDURE TDialogView.Free; OVERRIDE;
  294.  
  295.     VAR
  296.         itsTEView:            TDialogTEView;
  297.  
  298.     BEGIN
  299.     FreeIfObject(fParamTxt);
  300.     fParamTxt := NIL;
  301.  
  302.     { We postpone freeing fTEView because we don't know if it's still associated with an
  303.       edittext view.  (At this point it normally wouldn't be associated with an edittext,
  304.       but you never know…  So, free it after we've free'd all our subviews, including
  305.       any edittext view that fTEView might be associated with. We also disassociated from
  306.       its superview, if any, to avoid having free'd for us by INHERITED Free. }
  307.  
  308.     itsTEView := fTEView;                                { Can't refer to fTEView after calling
  309.                                                          INHERITED Free }
  310.     fTEView := NIL;
  311.  
  312.     IF (itsTEView <> NIL) & (itsTEView.fSuperView <> NIL) THEN
  313.         itsTEView.fSuperView.RemoveSubView(itsTEView);
  314.  
  315.     INHERITED Free;
  316.  
  317.     FreeIfObject(itsTEView);                            { Now free this puppy }
  318.     itsTEView := NIL;
  319.     END;
  320.  
  321. {--------------------------------------------------------------------------------------------------}
  322. {$S DlgRes}
  323.  
  324. FUNCTION TDialogView.CanDismiss(dismissing: IDType): BOOLEAN;
  325.  
  326.     VAR
  327.         dismissingView:     TView;
  328.         successful:         BOOLEAN;
  329.  
  330.     BEGIN
  331.     { First, make sure the view initiating the the dismissal, if any, is enabled. }
  332.  
  333.     IF LONGINT(dismissing) <> LONGINT(kNoIdentifier) THEN
  334.         dismissingView := FindSubView(dismissing)
  335.     ELSE
  336.         dismissingView := NIL;                            { no dismissing view }
  337.  
  338.     { Thanks Tommi GESSL }
  339.     successful := (dismissingView = NIL) | (dismissingView.IsViewEnabled);
  340.     CanDismiss := successful;
  341.  
  342.     IF successful THEN                                    { test only we haven´t failed }
  343.         { Now, if we're not cancelling, make sure the current edit text is valid and
  344.         return false if it isn't.}
  345.  
  346.         IF (LONGINT(fCancelItem) = LONGINT(kNoIdentifier)) | (dismissing <> fCancelItem) THEN
  347.             BEGIN
  348.             DoSelectEditText(NIL, False);                { Attempt to deselect current edit text }
  349.             CanDismiss := fCurrentEditText = NIL;        { Successful only if it was deselected }
  350.             END;
  351.     END;
  352.  
  353. {--------------------------------------------------------------------------------------------------}
  354. {$S DlgNonRes}
  355.  
  356. PROCEDURE TDialogView.CantDeselect(theEditText: TEditText;
  357.                                    reason: LONGINT);
  358.  
  359.     VAR
  360.         aString:            Str255;
  361.  
  362.     BEGIN
  363.     IF reason <> kValidValue THEN
  364.         BEGIN
  365.         IF reason <> kErrorHandled THEN                 { go ahead and post an alert }
  366.             BEGIN
  367.             IF (reason < 1) | (reason > kNoOfDefaultReasons) THEN
  368.                 reason := kInvalidValue;
  369.  
  370.             GetIndString(aString, kInvalidValueReasons, reason);
  371.             ParamText(aString, '', '', '');
  372.             StdAlert(phInvalidValue);
  373.             END;
  374.         aString := theEditText.fDataHandle^^;            { Restart with previous value }
  375.         theEditText.RestartEdit(aString);
  376.         END;
  377.     END;
  378.  
  379. {--------------------------------------------------------------------------------------------------}
  380. {$S DlgClose}
  381.  
  382. PROCEDURE TDialogView.Close; OVERRIDE;
  383.  
  384.     BEGIN
  385.     IF LONGINT(fDismisser) = LONGINT(kNoIdentifier) THEN
  386.         DismissDialog(kNoIdentifier);
  387.  
  388.     INHERITED Close;
  389.     END;
  390.  
  391. {--------------------------------------------------------------------------------------------------}
  392. {$S DlgRes}
  393.  
  394. FUNCTION TDialogView.DeselectCurrentEditText: BOOLEAN;
  395.  
  396.     VAR
  397.         validateResult:     LONGINT;
  398.         itsWindow:            TWindow;
  399.         lastCommand:        TCommand;
  400.  
  401.     BEGIN
  402.     DeselectCurrentEditText := TRUE;
  403.  
  404.     IF fCurrentEditText <> NIL THEN
  405.         BEGIN
  406.         { Commit the last command to prevent undo from applying to the wrong edit text,
  407.           and to ensure that all changes are made before validating. }
  408.         IF (fTEView <> NIL) THEN
  409.             BEGIN
  410.             lastCommand := fTEView.GetLastCommand;
  411.             IF (lastCommand <> NIL) & (lastCommand.fView = fTEView) THEN
  412.                 fTEView.CommitLastCommand;
  413.             END;
  414.  
  415.         validateResult := fCurrentEditText.Validate;
  416.         IF validateResult = kValidValue THEN
  417.             BEGIN
  418.             fCurrentEditText.StopEdit;
  419.             fCurrentEditText := NIL;                    { No edit text is selected }
  420.             itsWindow := GetWindow;                     { Patch up the target change }
  421.             IF itsWindow <> NIL THEN
  422.                 itsWindow.SetTarget(SELF)
  423.             ELSE
  424.                 gApplication.SetTarget(gApplication);
  425.             END
  426.         ELSE
  427.             BEGIN
  428.             CantDeselect(fCurrentEditText, validateResult);
  429.             DeselectCurrentEditText := False;
  430.             END;
  431.         END;
  432.     END;
  433.  
  434. {--------------------------------------------------------------------------------------------------}
  435. {$S DlgClose}
  436.  
  437. PROCEDURE TDialogView.DismissDialog(dismisser: IDType);
  438.  
  439.     VAR
  440.         dismissingControl:    TControl;
  441.  
  442.     BEGIN
  443.     IF NOT fDismissed THEN
  444.         IF CanDismiss(dismisser) THEN
  445.             BEGIN
  446.             fDismissed := TRUE;
  447.             fDismisser := dismisser;
  448.             END
  449.         ELSE
  450.             Failure(noErr, 0);                            { Silent failure }
  451.     END;
  452.  
  453. {--------------------------------------------------------------------------------------------------}
  454. {$S DlgRes}
  455.  
  456. PROCEDURE TDialogView.DoChoice(origView: TView;
  457.                                itsChoice: INTEGER); OVERRIDE;
  458.  
  459.     BEGIN
  460.     CASE itsChoice OF
  461.         mEditTextHit:
  462.             BEGIN
  463.             {$IFC qDebug}
  464.             IF NOT Member(origView, TEditText) THEN
  465.                 ProgramBreak('Got mEditTextHit on non-TEditText view.')
  466.             ELSE
  467.             {$ENDC}
  468.                 DoSelectEditText(TEditText(origView), False);
  469.             END;
  470.         OTHERWISE
  471.             IF Member(origView, TControl) & TControl(origView).fDismissesDialog THEN
  472.                 DismissDialog(origView.fIdentifier)
  473.             ELSE
  474.                 INHERITED DoChoice(origView, itsChoice);
  475.     END;
  476.     END;
  477.  
  478. {--------------------------------------------------------------------------------------------------}
  479. {$S DlgRes}
  480.  
  481. FUNCTION TDialogView.DoCommandKey(ch: CHAR;
  482.                                   VAR info: EventInfo): TCommand; OVERRIDE;
  483.  
  484.     VAR
  485.         cancelView:         TView;
  486.  
  487.     BEGIN
  488.     IF IsViewEnabled & (ch = '.') & (LONGINT(fCancelItem) <> LONGINT(kNoIdentifier)) THEN
  489.         BEGIN
  490.         cancelView := FindSubView(fCancelItem);
  491.         IF (cancelView <> NIL) & Member(cancelView, TControl) THEN
  492.             BEGIN
  493.             IF cancelView.IsViewEnabled THEN
  494.                 TControl(cancelView).Flash;
  495.             TControl(cancelView).DoChoice(cancelView, TControl(cancelView).fDefChoice);
  496.             END
  497.         ELSE
  498.             DoChoice(cancelView, mCancelKey);
  499.         DoCommandKey := NIL;
  500.         END
  501.     ELSE
  502.         DoCommandKey := INHERITED DoCommandKey(ch, info);
  503.     END;
  504.  
  505. {--------------------------------------------------------------------------------------------------}
  506. {$S DlgRes}
  507.  
  508. FUNCTION TDialogView.DoKeyCommand(ch: CHAR;
  509.                                   aKeyCode: INTEGER;
  510.                                   VAR info: EventInfo): TCommand; OVERRIDE;
  511.  
  512.     VAR
  513.         defaultView:        TView;
  514.         cancelView:         TView;
  515.  
  516.     BEGIN
  517.     { If we get this far, nobody's handled the Tab, Enter, or Return keys, so we will  }
  518.     DoKeyCommand := NIL;
  519.     IF IsViewEnabled THEN
  520.         CASE ch OF
  521.             chEscape:
  522.                 IF aKeyCode = kClearVirtualCode THEN    { esc double for two different keys! }
  523.                     DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info)
  524.                 ELSE IF LONGINT(fCancelItem) <> LONGINT(kNoIdentifier) THEN
  525.                     BEGIN
  526.                     cancelView := FindSubView(fCancelItem);
  527.                     IF (cancelView <> NIL) & Member(cancelView, TControl) THEN
  528.                         BEGIN
  529.                         IF cancelView.IsViewEnabled THEN
  530.                             TControl(cancelView).Flash;
  531.                         TControl(cancelView).DoChoice(cancelView, TControl(cancelView).fDefChoice);
  532.                         END
  533.                     ELSE
  534.                         DoChoice(cancelView, mCancelKey);
  535.                     END
  536.                 ELSE
  537.                     DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
  538.             chTab:
  539.                 Tab(info.theShiftKey);
  540.             chEnter, chReturn:
  541.                 IF LONGINT(fDefaultItem) <> LONGINT(kNoIdentifier) THEN
  542.                     BEGIN
  543.                     defaultView := FindSubView(fDefaultItem);
  544.                     IF (defaultView <> NIL) & Member(defaultView, TControl) THEN
  545.                         BEGIN
  546.                         IF defaultView.IsViewEnabled THEN
  547.                             TControl(defaultView).Flash;
  548.                         TControl(defaultView).DoChoice(defaultView, TControl(defaultView).fDefChoice);
  549.                         END
  550.                     ELSE
  551.                         DoChoice(defaultView, mDefaultKey);
  552.                     END
  553.                 ELSE
  554.                     DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
  555.             OTHERWISE
  556.                 DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
  557.         END
  558.     ELSE
  559.         DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
  560.     END;
  561.  
  562. {--------------------------------------------------------------------------------------------------}
  563. {$S DlgRes}
  564.  
  565. PROCEDURE TDialogView.DoSelectEditText(theEditText: TEditText;
  566.                                        selectChars: BOOLEAN);
  567.  
  568.     VAR
  569.         itsWindow:            TWindow;
  570.  
  571.     BEGIN
  572.     IF theEditText <> fCurrentEditText THEN             { If we're not editing this view… }
  573.         BEGIN
  574.         IF DeselectCurrentEditText THEN
  575.             BEGIN
  576.             fCurrentEditText := theEditText;
  577.             IF theEditText <> NIL THEN
  578.                 BEGIN
  579.                 IF theEditText.fViewEnabled THEN
  580.                     theEditText.StartEdit(selectChars, fTEView)
  581.                     {$IFC qDebug}
  582.                 ELSE
  583.                     ProgramBreak('Attempt to select a disabled edit text view')
  584.                     {$ENDC}
  585.                                  ;
  586.                 END
  587.             ELSE
  588.                 BEGIN
  589.                 itsWindow := GetWindow;                 { Set the window's target to self }
  590.                 IF itsWindow <> NIL THEN
  591.                     itsWindow.SetTarget(SELF);
  592.                 END;
  593.             END;
  594.         END
  595.     ELSE IF selectChars & (theEditText <> NIL) THEN     { Make sure all the chars are selected. }
  596.         theEditText.SetSelection(0, MAXINT, kRedraw);
  597.     END;
  598.  
  599. {--------------------------------------------------------------------------------------------------}
  600. {$S DlgRes}
  601.  
  602. PROCEDURE TDialogView.EachEditText(PROCEDURE DoToEditText(theEditText: TEditText));
  603.  
  604.     PROCEDURE CheckSubView(theSubView: TView);
  605.  
  606.         BEGIN
  607.         IF Member(theSubView, TEditText) THEN
  608.             DoToEditText(TEditText(theSubView))
  609.         ELSE
  610.             theSubView.EachSubView(CheckSubView);
  611.         END;
  612.  
  613.     BEGIN
  614.     EachSubView(CheckSubView);
  615.     END;
  616.  
  617. {--------------------------------------------------------------------------------------------------}
  618. {$S DlgRes}
  619.  
  620. FUNCTION TDialogView.GetDialogView: TView; OVERRIDE;
  621.  
  622.     BEGIN
  623.     GetDialogView := SELF;
  624.     END;
  625.  
  626. {--------------------------------------------------------------------------------------------------}
  627. {$S DlgRes}
  628.  
  629. PROCEDURE TDialogView.Tab(tabBackward: BOOLEAN);
  630.  
  631.     VAR
  632.         first:                TEditText;
  633.         last:                TEditText;
  634.         next:                TEditText;
  635.         previous:            TEditText;
  636.  
  637.     BEGIN
  638.     SurveyEditText(first, last, next, previous);
  639.  
  640.     IF tabBackward THEN
  641.         next := previous;
  642.  
  643.     IF next <> NIL THEN
  644.         DoSelectEditText(next, TRUE);
  645.     END;
  646.  
  647. {--------------------------------------------------------------------------------------------------}
  648. {$S DlgOpen}
  649.  
  650. FUNCTION TDialogView.MakeTEView: TDialogTEView;
  651.  
  652.     VAR
  653.         aDialogTEView:        TDialogTEView;
  654.  
  655.     BEGIN
  656.     New(aDialogTEView);
  657.     FailNIL(aDialogTEView);
  658.     aDialogTEView.IDialogTEView(NIL, NIL, gZeroVPt, gZeroVPt, sizeRelSuperView, sizeVariable,
  659.                                 gZeroRect, gSystemStyle, teJustSystem, kWithoutStyle, False);
  660.  
  661.     aDialogTEView.fMinAhead := 1;    { Don't _jump_ the view ahead when autoscrolling for
  662.     scrollselectionintoview }
  663.  
  664.     MakeTEView := aDialogTEView;
  665.     END;
  666.  
  667. {--------------------------------------------------------------------------------------------------}
  668. {$S MAOpen}
  669.  
  670. PROCEDURE TDialogView.DoOpen;
  671.  
  672.     VAR
  673.         itsWindow:            TWindow;
  674.  
  675.     BEGIN
  676.     itsWindow := GetWindow;
  677.     IF (itsWindow <> NIL) & Member(itsWindow.fTarget, TEditText) THEN
  678.         { If the window's target is an edit text view, and that edit text view is installed
  679.           in this dialog, then select it.  Note that this can be problematic if the edit
  680.           text view is in nested dialog views. }
  681.         WITH itsWindow DO
  682.             IF FindSubView(TEditText(fTarget).fIdentifier) = fTarget THEN
  683.                 DoSelectEditText(TEditText(fTarget), TRUE);
  684.     END;
  685.  
  686. {--------------------------------------------------------------------------------------------------}
  687. {$S MAOpen}
  688.  
  689. PROCEDURE TDialogView.Open; OVERRIDE;
  690.  
  691.     BEGIN
  692.     fDismissed := False;
  693.     fDismisser := kNoIdentifier;
  694.     DoOpen;
  695.     INHERITED Open;
  696.     END;
  697.  
  698. {--------------------------------------------------------------------------------------------------}
  699. {$S DlgRes}
  700.  
  701. PROCEDURE TDialogView.ParamTxt(keyStr, valueStr: Str255);
  702.  
  703.     BEGIN
  704.     fParamTxt.InsertEntry(keyStr, valueStr);
  705.     END;
  706.  
  707. {--------------------------------------------------------------------------------------------------}
  708. {$S DlgRes}
  709.  
  710. FUNCTION TDialogView.PoseModally: IDType;
  711.  
  712.     LABEL 1;
  713.  
  714.     VAR
  715.         itsWindow:            TWindow;
  716.         fi:                 FailInfo;
  717.  
  718.     PROCEDURE HdlPoseModally(error: OSErr;
  719.                              message: LONGINT);
  720.  
  721.         BEGIN
  722.         IF error = noErr THEN
  723.             GOTO 1                                        { If no error then keep the dialog running }
  724.         ELSE
  725.             BEGIN
  726.             fDismissed := TRUE;                         { Avoid validating selected edit text }
  727.             itsWindow.Close;                            { If an error then close the dialog and exit
  728.                                                          via failure mechanism }
  729.             END;
  730.         END;
  731.  
  732.     BEGIN
  733.     itsWindow := GetWindow;
  734.     IF itsWindow <> NIL THEN
  735.         BEGIN
  736.         gApplication.CommitLastCommand;                 { Make sure that the undo menu reflects }
  737.         { the view being looked at.  Otherwise }
  738.         { the undo menu will be wrong.        }
  739.  
  740.         itsWindow.Open;
  741.         itsWindow.Select;                                { Bring it to the front }
  742.  
  743.         fDismissed := False;
  744.         REPEAT
  745.             CatchFailures(fi, HdlPoseModally);
  746.             gApplication.PollEvent(kAllowApplicationToSleep);
  747.             Success(fi);
  748.         1:
  749.         UNTIL fDismissed;
  750.         PoseModally := fDismisser;
  751.  
  752.         END
  753.     ELSE
  754.         PoseModally := kNoIdentifier;
  755.     END;
  756.  
  757. {--------------------------------------------------------------------------------------------------}
  758. {$S DlgRes}
  759.  
  760. PROCEDURE TDialogView.ReplaceText(VAR theText: Str255);
  761.  
  762.     PROCEDURE ReplaceOnce(item: TEntry);
  763.  
  764.         VAR
  765.             index:                INTEGER;
  766.  
  767.         BEGIN
  768.         WITH item DO
  769.             REPEAT
  770.                 index := Pos(fKey^^, theText);
  771.                 IF index > 0 THEN
  772.                     BEGIN
  773.                     Delete(theText, index, Length(fKey^^));
  774.                     IF Length(theText) + Length(fValue^^) < SIZEOF(Str255) THEN
  775.                         Insert(fValue^^, theText, index);
  776.                     END;
  777.             UNTIL index = 0;
  778.         END;
  779.  
  780.     BEGIN
  781.     fParamTxt.fEntries.Each(ReplaceOnce);
  782.     END;
  783.  
  784. {--------------------------------------------------------------------------------------------------}
  785. {$S DlgRes}
  786.  
  787. PROCEDURE TDialogView.SelectEditText(itsIdentifier: IDType;
  788.                                      selectChars: BOOLEAN);
  789.  
  790.     VAR
  791.         aSubView:            TView;
  792.  
  793.     BEGIN
  794.     aSubView := FindSubView(itsIdentifier);
  795.     IF (aSubView <> NIL) & (Member(aSubView, TEditText)) THEN
  796.         DoSelectEditText(TEditText(aSubView), selectChars);
  797.     END;
  798.  
  799. {--------------------------------------------------------------------------------------------------}
  800. {$S DlgRes}
  801.  
  802. PROCEDURE TDialogView.SurveyEditText(VAR first, last, next, previous: TEditText);
  803.  
  804.     VAR
  805.         foundCurrent:        BOOLEAN;
  806.  
  807.     PROCEDURE Survey(theEditText: TEditText);
  808.  
  809.         BEGIN
  810.         IF theEditText.fViewEnabled & theEditText.fShown THEN
  811.             BEGIN
  812.             IF first = NIL THEN
  813.                 first := theEditText;
  814.             last := theEditText;
  815.             IF theEditText = fCurrentEditText THEN
  816.                 foundCurrent := TRUE
  817.             ELSE IF foundCurrent & (next = NIL) THEN
  818.                 next := theEditText;
  819.             IF NOT foundCurrent THEN
  820.                 previous := theEditText;
  821.             END;
  822.         END;
  823.  
  824.     BEGIN
  825.     foundCurrent := False;
  826.     next := NIL;
  827.     previous := NIL;
  828.     first := NIL;
  829.     last := NIL;
  830.     EachEditText(Survey);
  831.     IF next = NIL THEN
  832.         next := first;
  833.     IF previous = NIL THEN
  834.         previous := last;
  835.     END;
  836.  
  837. {--------------------------------------------------------------------------------------------------}
  838. {$S DlgFields}
  839.  
  840. PROCEDURE TDialogView.Fields(PROCEDURE DoToField(fieldName: Str255;
  841.                                                  fieldAddr: Ptr;
  842.                                                  fieldType: INTEGER)); OVERRIDE;
  843.  
  844.     BEGIN
  845.     DoToField('TDialogView', NIL, bClass);
  846.     DoToField('fDefaultItem', @fDefaultItem, bIDType);
  847.     DoToField('fCancelItem', @fCancelItem, bIDType);
  848.     DoToField('fParamTxt', @fParamTxt, bObject);
  849.     DoToField('fCurrentEditText', @fCurrentEditText, bObject);
  850.     DoToField('fTEView', @fTEView, bObject);
  851.     DoToField('fDismissed', @fDismissed, bBoolean);
  852.     DoToField('fDismisser', @fDismisser, bIDType);
  853.  
  854.     INHERITED Fields(DoToField);
  855.     END;
  856.  
  857. {--------------------------------------------------------------------------------------------------}
  858. {$S DlgOpen}
  859.  
  860. PROCEDURE TButton.IButton(itsSuperView: TView;
  861.                           itsLocation, itsSize: VPoint;
  862.                           itsHSizeDet, itsVSizeDet: SizeDeterminer;
  863.                           itsLabel: Str255);
  864.  
  865.     BEGIN
  866.     ICtlMgr(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, itsLabel, 0, 0, 0,
  867.             pushButProc);
  868.     fDefChoice := mButtonHit;
  869.     END;
  870.  
  871. {--------------------------------------------------------------------------------------------------}
  872. {$S DlgOpen}
  873.  
  874. PROCEDURE TButton.IRes(itsDocument: TDocument;
  875.                        itsSuperView: TView;
  876.                        VAR itsParams: Ptr); OVERRIDE;
  877.  
  878.     VAR
  879.         itsArea:            Rect;
  880.  
  881.     BEGIN
  882.     INHERITED IRes(NIL, itsSuperView, itsParams);
  883.  
  884.     fDefChoice := mButtonHit;
  885.     ControlArea(itsArea);
  886.     WITH ButtonTemplatePtr(itsParams)^ DO
  887.         CreateCMgrControl(itsArea, itsLabel, 0, 0, 0, pushButProc);
  888.  
  889.     OffsetPtrWStr(itsParams, SIZEOF(ButtonTemplate));
  890.     END;
  891.  
  892. {--------------------------------------------------------------------------------------------------}
  893. {$S MAWriteRes}
  894.  
  895. PROCEDURE TButton.WRes(theResource: ViewRsrcHndl;
  896.                        VAR itsParams: Ptr); OVERRIDE;
  897.  
  898.     VAR
  899.         theLabel:            Str255;
  900.         btPtr:                ButtonTemplatePtr;
  901.  
  902.     BEGIN
  903.     INHERITED WRes(theResource, itsParams);
  904.  
  905.     GetText(theLabel);
  906.  
  907.     btPtr := ButtonTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(ButtonTemplate),
  908.                                              Length(theLabel)));
  909.  
  910.     { btPtr^.itsLabel := theLabel; }
  911.     CopyStr255(theLabel, PRStr(btPtr^.itsLabel));
  912.     END;
  913.  
  914. {--------------------------------------------------------------------------------------------------}
  915. {$S MAWriteRes}
  916.  
  917. PROCEDURE TButton.WriteRes(theResource: ViewRsrcHndl;
  918.                            VAR itsParams: Ptr); OVERRIDE;
  919.  
  920.     BEGIN
  921.     gWResSignature := 'butn'; gWResType := 'TButton';
  922.     WRes(theResource, itsParams);
  923.     END;
  924.  
  925. {--------------------------------------------------------------------------------------------------}
  926. {$S DlgFields}
  927.  
  928. PROCEDURE TButton.Fields(PROCEDURE DoToField(fieldName: Str255;
  929.                                              fieldAddr: Ptr;
  930.                                              fieldType: INTEGER)); OVERRIDE;
  931.  
  932.     BEGIN
  933.     DoToField('TButton', NIL, bClass);
  934.  
  935.     INHERITED Fields(DoToField);
  936.     END;
  937.  
  938. {--------------------------------------------------------------------------------------------------}
  939. {$S DlgOpen}
  940.  
  941. PROCEDURE TCheckBox.ICheckBox(itsSuperView: TView;
  942.                               itsLocation, itsSize: VPoint;
  943.                               itsHSizeDet, itsVSizeDet: SizeDeterminer;
  944.                               itsLabel: Str255;
  945.                               isTurnedOn: BOOLEAN);
  946.  
  947.     BEGIN
  948.     ICtlMgr(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, itsLabel, 0, 0, 1,
  949.             checkBoxProc);
  950.     SetState(isTurnedOn, kDontRedraw);
  951.     fDefChoice := mCheckBoxHit;
  952.     END;
  953.  
  954. {--------------------------------------------------------------------------------------------------}
  955. {$S DlgOpen}
  956.  
  957. PROCEDURE TCheckBox.IRes(itsDocument: TDocument;
  958.                          itsSuperView: TView;
  959.                          VAR itsParams: Ptr); OVERRIDE;
  960.  
  961.     VAR
  962.         itsArea:            Rect;
  963.  
  964.     BEGIN
  965.     INHERITED IRes(NIL, itsSuperView, itsParams);
  966.  
  967.     fDefChoice := mCheckBoxHit;
  968.     ControlArea(itsArea);
  969.     WITH CheckBoxTemplatePtr(itsParams)^ DO
  970.         CreateCMgrControl(itsArea, itsLabel, ORD(isOn), 0, 1, checkBoxProc);
  971.  
  972.     OffsetPtrWStr(itsParams, SIZEOF(CheckBoxTemplate));
  973.     END;
  974.  
  975. {--------------------------------------------------------------------------------------------------}
  976. {$S MAWriteRes}
  977.  
  978. PROCEDURE TCheckBox.WRes(theResource: ViewRsrcHndl;
  979.                          VAR itsParams: Ptr); OVERRIDE;
  980.  
  981.     VAR
  982.         theLabel:            Str255;
  983.         cbPtr:                CheckBoxTemplatePtr;
  984.  
  985.     BEGIN
  986.     INHERITED WRes(theResource, itsParams);
  987.  
  988.     GetText(theLabel);
  989.  
  990.     cbPtr := CheckBoxTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(CheckBoxTemplate),
  991.                                                Length(theLabel)));
  992.  
  993.     cbPtr^.isOn := isOn;
  994.     { cbPtr^.itsLabel := theLabel; }
  995.     CopyStr255(theLabel, PRStr(cbPtr^.itsLabel));
  996.     END;
  997.  
  998. {--------------------------------------------------------------------------------------------------}
  999. {$S MAWriteRes}
  1000.  
  1001. PROCEDURE TCheckBox.WriteRes(theResource: ViewRsrcHndl;
  1002.                              VAR itsParams: Ptr); OVERRIDE;
  1003.  
  1004.     BEGIN
  1005.     gWResSignature := 'chkb'; gWResType := 'TCheckBox';
  1006.     WRes(theResource, itsParams);
  1007.     END;
  1008.  
  1009. {--------------------------------------------------------------------------------------------------}
  1010. {$S DlgRes}
  1011.  
  1012. PROCEDURE TCheckBox.DoChoice(origView: TView;
  1013.                              itsChoice: INTEGER);
  1014.  
  1015.     BEGIN
  1016.     IF itsChoice = mCheckBoxHit THEN
  1017.         Toggle(kRedraw);
  1018.     INHERITED DoChoice(origView, itsChoice);
  1019.     END;
  1020.  
  1021. {--------------------------------------------------------------------------------------------------}
  1022. {$S DlgRes}
  1023.  
  1024. FUNCTION TCheckBox.isOn: BOOLEAN;
  1025.  
  1026.     BEGIN
  1027.     isOn := GetLongVal <> 0;
  1028.     END;
  1029.  
  1030. {--------------------------------------------------------------------------------------------------}
  1031. {$S DlgRes}
  1032.  
  1033. PROCEDURE TCheckBox.SetState(state, redraw: BOOLEAN);
  1034.  
  1035.     BEGIN
  1036.     SetLongVal(ORD(state), redraw);
  1037.     END;
  1038.  
  1039. {--------------------------------------------------------------------------------------------------}
  1040. {$S DlgRes}
  1041.  
  1042. PROCEDURE TCheckBox.Toggle(redraw: BOOLEAN);
  1043.  
  1044.     BEGIN
  1045.     SetLongVal(ORD(NOT isOn), redraw);
  1046.     END;
  1047.  
  1048. {--------------------------------------------------------------------------------------------------}
  1049. {$S DlgRes}
  1050.  
  1051. PROCEDURE TCheckBox.ToggleIf(matchState, redraw: BOOLEAN);
  1052.  
  1053.     BEGIN
  1054.     IF isOn = matchState THEN
  1055.         SetLongVal(ORD(NOT isOn), redraw);
  1056.     END;
  1057.  
  1058. {--------------------------------------------------------------------------------------------------}
  1059. {$S DlgFields}
  1060.  
  1061. PROCEDURE TCheckBox.Fields(PROCEDURE DoToField(fieldName: Str255;
  1062.                                                fieldAddr: Ptr;
  1063.                                                fieldType: INTEGER)); OVERRIDE;
  1064.  
  1065.     BEGIN
  1066.     DoToField('TCheckBox', NIL, bClass);
  1067.  
  1068.     INHERITED Fields(DoToField);
  1069.     END;
  1070.  
  1071. {--------------------------------------------------------------------------------------------------}
  1072. {$S DlgOpen}
  1073.  
  1074. PROCEDURE TRadio.IRadio(itsSuperView: TView;
  1075.                         itsLocation, itsSize: VPoint;
  1076.                         itsHSizeDet, itsVSizeDet: SizeDeterminer;
  1077.                         itsLabel: Str255;
  1078.                         isTurnedOn: BOOLEAN);
  1079.  
  1080.     BEGIN
  1081.     ICtlMgr(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, itsLabel, 0, 0, 1,
  1082.             radioButProc);
  1083.     SetState(isTurnedOn, kDontRedraw);
  1084.     fDefChoice := mRadioHit;
  1085.     END;
  1086.  
  1087. {--------------------------------------------------------------------------------------------------}
  1088. {$S DlgOpen}
  1089.  
  1090. PROCEDURE TRadio.IRes(itsDocument: TDocument;
  1091.                       itsSuperView: TView;
  1092.                       VAR itsParams: Ptr); OVERRIDE;
  1093.  
  1094.     VAR
  1095.         itsArea:            Rect;
  1096.  
  1097.     BEGIN
  1098.     INHERITED IRes(NIL, itsSuperView, itsParams);
  1099.  
  1100.     fDefChoice := mRadioHit;
  1101.     ControlArea(itsArea);
  1102.     WITH RadioTemplatePtr(itsParams)^ DO
  1103.         CreateCMgrControl(itsArea, itsLabel, ORD(isOn), 0, 1, radioButProc);
  1104.     OffsetPtrWStr(itsParams, SIZEOF(RadioTemplate));
  1105.     END;
  1106.  
  1107. {--------------------------------------------------------------------------------------------------}
  1108. {$S MAWriteRes}
  1109.  
  1110. PROCEDURE TRadio.WRes(theResource: ViewRsrcHndl;
  1111.                       VAR itsParams: Ptr); OVERRIDE;
  1112.  
  1113.     VAR
  1114.         theLabel:            Str255;
  1115.         rdPtr:                RadioTemplatePtr;
  1116.  
  1117.     BEGIN
  1118.     INHERITED WRes(theResource, itsParams);
  1119.  
  1120.     GetText(theLabel);
  1121.  
  1122.     rdPtr := RadioTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(RadioTemplate),
  1123.                                             Length(theLabel)));
  1124.  
  1125.     rdPtr^.isOn := isOn;
  1126.     { rdPtr^.itsLabel := theLabel; }
  1127.     CopyStr255(theLabel, PRStr(rdPtr^.itsLabel));
  1128.     END;
  1129.  
  1130. {--------------------------------------------------------------------------------------------------}
  1131. {$S MAWriteRes}
  1132.  
  1133. PROCEDURE TRadio.WriteRes(theResource: ViewRsrcHndl;
  1134.                           VAR itsParams: Ptr); OVERRIDE;
  1135.  
  1136.     BEGIN
  1137.     gWResSignature := 'radb'; gWResType := 'TRadio';
  1138.     WRes(theResource, itsParams);
  1139.     END;
  1140.  
  1141. {--------------------------------------------------------------------------------------------------}
  1142. {$S DlgRes}
  1143.  
  1144. PROCEDURE TRadio.DoChoice(origView: TView;
  1145.                           itsChoice: INTEGER);
  1146.  
  1147.     BEGIN
  1148.     IF (itsChoice = mRadioHit) & NOT isOn THEN
  1149.         Toggle(kRedraw);
  1150.     INHERITED DoChoice(origView, itsChoice);
  1151.     END;
  1152.  
  1153. {--------------------------------------------------------------------------------------------------}
  1154. {$S DlgRes}
  1155.  
  1156. FUNCTION TRadio.isOn: BOOLEAN;
  1157.  
  1158.     BEGIN
  1159.     isOn := GetLongVal <> 0;
  1160.     END;
  1161.  
  1162. {--------------------------------------------------------------------------------------------------}
  1163. {$S DlgRes}
  1164.  
  1165. PROCEDURE TRadio.SetState(state, redraw: BOOLEAN);
  1166.  
  1167.     BEGIN
  1168.     SetLongVal(ORD(state), redraw);
  1169.     END;
  1170.  
  1171. {--------------------------------------------------------------------------------------------------}
  1172. {$S DlgRes}
  1173.  
  1174. PROCEDURE TRadio.Toggle(redraw: BOOLEAN);
  1175.  
  1176.     BEGIN
  1177.     SetLongVal(ORD(NOT isOn), redraw);
  1178.     END;
  1179.  
  1180. {--------------------------------------------------------------------------------------------------}
  1181. {$S DlgRes}
  1182.  
  1183. PROCEDURE TRadio.ToggleIf(matchState, redraw: BOOLEAN);
  1184.  
  1185.     BEGIN
  1186.     IF isOn = matchState THEN
  1187.         SetLongVal(ORD(NOT isOn), redraw);
  1188.     END;
  1189.  
  1190. {--------------------------------------------------------------------------------------------------}
  1191. {$S DlgFields}
  1192.  
  1193. PROCEDURE TRadio.Fields(PROCEDURE DoToField(fieldName: Str255;
  1194.                                             fieldAddr: Ptr;
  1195.                                             fieldType: INTEGER)); OVERRIDE;
  1196.  
  1197.     BEGIN
  1198.     DoToField('TRadio', NIL, bClass);
  1199.  
  1200.     INHERITED Fields(DoToField);
  1201.     END;
  1202.  
  1203. {--------------------------------------------------------------------------------------------------}
  1204. {$S DlgOpen}
  1205.  
  1206. PROCEDURE TCluster.ICluster(itsSuperView: TView;
  1207.                             itsLocation, itsSize: VPoint;
  1208.                             itsHSizeDet, itsVSizeDet: SizeDeterminer;
  1209.                             itsRsrcID, itsIndex: INTEGER);
  1210.  
  1211.     VAR
  1212.         aString:            Str255;
  1213.         fi:                 FailInfo;
  1214.  
  1215.     PROCEDURE HandleFailure(error: OSErr;
  1216.                             message: LONGINT);
  1217.  
  1218.         BEGIN
  1219.         Free;
  1220.         END;
  1221.  
  1222.     BEGIN
  1223.     fDataHandle := NIL;
  1224.     IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  1225.     fRsrcID := itsRsrcID;
  1226.     fIndex := itsIndex;
  1227.     IF fRsrcID <> kNoResource THEN
  1228.         BEGIN
  1229.         CatchFailures(fi, HandleFailure);
  1230.         GetIndString(aString, fRsrcID, fIndex);
  1231.         FailResError;
  1232.         Success(fi);
  1233.         SetLabel(aString, kDontRedraw);
  1234.         END;
  1235.     ViewEnable(False, kDontRedraw);                     { Default is not to enable hit testing }
  1236.     fDefChoice := mClusterHit;
  1237.     END;
  1238.  
  1239. {--------------------------------------------------------------------------------------------------}
  1240. {$S DlgOpen}
  1241.  
  1242. PROCEDURE TCluster.IRes(itsDocument: TDocument;
  1243.                         itsSuperView: TView;
  1244.                         VAR itsParams: Ptr); OVERRIDE;
  1245.  
  1246.     BEGIN
  1247.     fDataHandle := NIL;
  1248.     INHERITED IRes(NIL, itsSuperView, itsParams);
  1249.     fDefChoice := mClusterHit;
  1250.  
  1251.     WITH ClusterTemplatePtr(itsParams)^ DO
  1252.         SetLabel(itsLabel, kDontRedraw);
  1253.  
  1254.     OffsetPtrWStr(itsParams, SIZEOF(ClusterTemplate));
  1255.     END;
  1256.  
  1257. {--------------------------------------------------------------------------------------------------}
  1258. {$S MAWriteRes}
  1259.  
  1260. PROCEDURE TCluster.WRes(theResource: ViewRsrcHndl;
  1261.                         VAR itsParams: Ptr); OVERRIDE;
  1262.  
  1263.     VAR
  1264.         theLabel:            Str255;
  1265.         clPtr:                ClusterTemplatePtr;
  1266.  
  1267.     BEGIN
  1268.     INHERITED WRes(theResource, itsParams);
  1269.  
  1270.     GetLabel(theLabel);
  1271.  
  1272.     clPtr := ClusterTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(ClusterTemplate),
  1273.                                               Length(theLabel)));
  1274.  
  1275.     { clPtr^.itsLabel := theLabel; }
  1276.     CopyStr255(theLabel, PRStr(clPtr^.itsLabel));
  1277.     END;
  1278.  
  1279. {--------------------------------------------------------------------------------------------------}
  1280. {$S MAWriteRes}
  1281.  
  1282. PROCEDURE TCluster.WriteRes(theResource: ViewRsrcHndl;
  1283.                             VAR itsParams: Ptr); OVERRIDE;
  1284.  
  1285.     BEGIN
  1286.     gWResSignature := 'clus'; gWResType := 'TCluster';
  1287.     WRes(theResource, itsParams);
  1288.     END;
  1289.  
  1290. {--------------------------------------------------------------------------------------------------}
  1291. {$S DlgClose}
  1292.  
  1293. PROCEDURE TCluster.Free; OVERRIDE;
  1294.  
  1295.     BEGIN
  1296.     ReleaseLabel;
  1297.     INHERITED Free;
  1298.     END;
  1299.  
  1300. {--------------------------------------------------------------------------------------------------}
  1301. {$S DlgRes}
  1302.  
  1303. PROCEDURE TCluster.DoChoice(origView: TView;
  1304.                             itsChoice: INTEGER); OVERRIDE;
  1305.  
  1306.     PROCEDURE ResetRadios(aView: TView);
  1307.  
  1308.         BEGIN
  1309.         IF Member(aView, TRadio) &                        { If the subview is a TRadio, and… }
  1310.            (aView <> origView) THEN                     { …it's not the calling radio… }
  1311.             TRadio(aView).SetState(False, kRedraw);     { …set it off and redraw it }
  1312.         END;
  1313.  
  1314.     BEGIN
  1315.     IF (itsChoice = mRadioHit) &                        { If we got this far, a radio's changed
  1316.                                                          state }
  1317.        (origView.fSuperView = SELF) THEN                { Only worry about it if it's our subview! }
  1318.         EachSubView(ResetRadios);                        { Reset everybody except the calling radio }
  1319.     INHERITED DoChoice(origView, itsChoice);
  1320.     END;
  1321.  
  1322. {--------------------------------------------------------------------------------------------------}
  1323. {$S DlgRes}
  1324.  
  1325. PROCEDURE TCluster.Draw(area: Rect); OVERRIDE;
  1326.  
  1327.     VAR
  1328.         fontHt:             INTEGER;
  1329.         labelWd:            INTEGER;
  1330.         oldTop:             INTEGER;
  1331.         fInfo:                FontInfo;
  1332.         theFrame:            Rect;
  1333.         theText:            Str255;
  1334.         aDialogView:        TDialogView;
  1335.         aTextStyle:         TextStyle;
  1336.  
  1337.     BEGIN
  1338.     IF qDebug THEN
  1339.         AssumeFocused;
  1340.  
  1341.     IF fDataHandle <> NIL THEN
  1342.         BEGIN
  1343.         {$Push} {$H-}
  1344.         WITH fPenSize DO
  1345.             PenSize(h, v);
  1346.         {$Pop}
  1347.         GetFontInfo(fInfo);                             { Determine label's height }
  1348.         WITH fInfo DO
  1349.             fontHt := ascent + descent + leading;
  1350.         ControlArea(theFrame);                            { Get the control's extent }
  1351.         oldTop := theFrame.top;
  1352.         {$Push} {$H-}
  1353.         WITH fPenSize DO
  1354.             InsetRect(theFrame, h + 1, v + 1);             { Inset the frame a little }
  1355.         {$Pop}
  1356.         theFrame.top := oldTop + BSR(fontHt, 1);        { Bump top so it cuts label in half }
  1357.  
  1358.         FrameRect(theFrame);                            { Draw the frame }
  1359.  
  1360.         CopyStr255(fDataHandle^^, @theText);
  1361.         aDialogView := TDialogView(GetDialogView);
  1362.         IF aDialogView <> NIL THEN
  1363.             aDialogView.ReplaceText(theText);
  1364.  
  1365.         { !!! Really need a method to draw the title }
  1366.         labelWd := StringWidth(theText) + 8;
  1367.         SetRect(theFrame, 16, 0, labelWd + 16, fontHt);
  1368.         MATextBox(Ptr(ORD4(@theText) + 1), Length(theText), theFrame, teJustCenter, kNoAutoWrap, NIL,
  1369.                 kEraseFirst, kNoSpaceForCaret);
  1370.         END;
  1371.     INHERITED Draw(area);                                { Let parents have a chance to draw too }
  1372.     END;
  1373.  
  1374. {--------------------------------------------------------------------------------------------------}
  1375. {$S DlgNonRes}
  1376.  
  1377. PROCEDURE TCluster.GetLabel(VAR theLabel: Str255);
  1378.  
  1379.     BEGIN
  1380.     IF fDataHandle <> NIL THEN
  1381.         theLabel := fDataHandle^^
  1382.     ELSE
  1383.         theLabel := '';
  1384.     END;
  1385.  
  1386. {--------------------------------------------------------------------------------------------------}
  1387. {$S DlgNonRes}
  1388.  
  1389. PROCEDURE TCluster.ReleaseLabel;
  1390.  
  1391.     BEGIN
  1392.     Handle(fDataHandle) := DisposeIfHandle(fDataHandle);
  1393.  
  1394.     fRsrcID := kNoResource;
  1395.     END;
  1396.  
  1397. {--------------------------------------------------------------------------------------------------}
  1398. {$S DlgRes}
  1399.  
  1400. FUNCTION TCluster.ReportCurrent: IDType;
  1401.  
  1402.     VAR
  1403.         rView:                TView;
  1404.  
  1405.     FUNCTION FindRadio(aView: TView): BOOLEAN;
  1406.  
  1407.         BEGIN
  1408.         FindRadio := Member(aView, TRadio) & TRadio(aView).isOn;
  1409.         END;
  1410.  
  1411.     BEGIN
  1412.     rView := FirstSubViewThat(FindRadio);
  1413.     IF rView <> NIL THEN
  1414.         ReportCurrent := rView.fIdentifier
  1415.     ELSE
  1416.         ReportCurrent := kNoIdentifier;
  1417.     END;
  1418.  
  1419. {--------------------------------------------------------------------------------------------------}
  1420. {$S DlgNonRes}
  1421.  
  1422. PROCEDURE TCluster.SetLabel(theLabel: Str255;
  1423.                             redraw: BOOLEAN);
  1424.  
  1425.     BEGIN
  1426.     ReleaseLabel;
  1427.     IF theLabel <> '' THEN
  1428.         BEGIN
  1429.         fDataHandle := NewString(theLabel);
  1430.         IF MemError <> noErr THEN
  1431.             fDataHandle := NIL;
  1432.         END;
  1433.     IF redraw THEN
  1434.         ForceRedraw;
  1435.     END;
  1436.  
  1437. {--------------------------------------------------------------------------------------------------}
  1438. {$S DlgFields}
  1439.  
  1440. PROCEDURE TCluster.Fields(PROCEDURE DoToField(fieldName: Str255;
  1441.                                               fieldAddr: Ptr;
  1442.                                               fieldType: INTEGER)); OVERRIDE;
  1443.  
  1444.     VAR
  1445.         aString:            Str255;
  1446.  
  1447.     BEGIN
  1448.     DoToField('TCluster', NIL, bClass);
  1449.     DoToField('fRsrcID', @fRsrcID, bInteger);
  1450.     DoToField('fIndex', @fIndex, bInteger);
  1451.     DoToField('fDataHandle', @fDataHandle, bHandle);
  1452.     IF fDataHandle <> NIL THEN
  1453.         BEGIN
  1454.         aString := fDataHandle^^;
  1455.         DoToField('fDataHandle^^', @aString, bString);
  1456.         END;
  1457.  
  1458.     INHERITED Fields(DoToField);
  1459.     END;
  1460.  
  1461. {--------------------------------------------------------------------------------------------------}
  1462. {$S DlgOpen}
  1463.  
  1464. PROCEDURE TIcon.IIcon(itsSuperView: TView;
  1465.                       itsLocation, itsSize: VPoint;
  1466.                       itsHSizeDet, itsVSizeDet: SizeDeterminer;
  1467.                       itsRsrcID: INTEGER;
  1468.                       preferColor: BOOLEAN);
  1469.  
  1470.     VAR
  1471.         fi:                 FailInfo;
  1472.         itsRsrcHandle:        Handle;
  1473.         savedState:            SignedByte;
  1474.  
  1475.     PROCEDURE HandleFailure(error: OSErr;
  1476.                             message: LONGINT);
  1477.  
  1478.         BEGIN
  1479.         Free;
  1480.         END;
  1481.  
  1482.     BEGIN
  1483.     fDataHandle := NIL;
  1484.     IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  1485.     fPreferColor := preferColor;
  1486.     fRsrcID := itsRsrcID;
  1487.     IF fRsrcID <> kNoResource THEN
  1488.         BEGIN
  1489.         CatchFailures(fi, HandleFailure);
  1490.         IF fPreferColor THEN
  1491.             IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  1492.                 BEGIN
  1493.                 { make the 'cicn' resource non-purgeable, so the Toolbox doesn't die }
  1494.                 itsRsrcHandle := GetResource('cicn', fRsrcID);
  1495.                 IF itsRsrcHandle <> NIL THEN
  1496.                     BEGIN
  1497.                     savedState := HGetState(itsRsrcHandle);
  1498.                     HNoPurge(itsRsrcHandle);
  1499.                     END;
  1500.                 
  1501.                 fDataHandle := Handle(GetCIcon(fRsrcID));
  1502.             
  1503.                 { restore the state of the 'cicn' resource }
  1504.                 IF itsRsrcHandle <> NIL THEN
  1505.                     HSetState(itsRsrcHandle, savedState);
  1506.                 END;
  1507.         IF fDataHandle = NIL THEN
  1508.             BEGIN
  1509.             fDataHandle := GetIcon(fRsrcID);
  1510.             IF fDataHandle <> NIL THEN
  1511.                 fPreferColor := NOT kPreferColor;        { Either can't or won't }
  1512.             END;
  1513.         FailResError;
  1514.         Success(fi);
  1515.         END;
  1516.     ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
  1517.     fDefChoice := mIconHit;
  1518.     END;
  1519.  
  1520. {--------------------------------------------------------------------------------------------------}
  1521. {$S DlgOpen}
  1522.  
  1523. PROCEDURE TIcon.IRes(itsDocument: TDocument;
  1524.                      itsSuperView: TView;
  1525.                      VAR itsParams: Ptr); OVERRIDE;
  1526.  
  1527.     VAR
  1528.         fi:                 FailInfo;
  1529.         itsRsrcHandle:        Handle;
  1530.         savedState:            SignedByte;
  1531.  
  1532.     PROCEDURE HandleFailure(error: OSErr;
  1533.                             message: LONGINT);
  1534.  
  1535.         BEGIN
  1536.         Free;
  1537.         END;
  1538.  
  1539.     BEGIN
  1540.     fDataHandle := NIL;
  1541.     INHERITED IRes(NIL, itsSuperView, itsParams);
  1542.  
  1543.     WITH IconTemplatePtr(itsParams)^ DO
  1544.         BEGIN
  1545.         fPreferColor := preferColor;
  1546.         fRsrcID := rsrcID;
  1547.         END;
  1548.     IF fRsrcID <> kNoResource THEN
  1549.         BEGIN
  1550.         CatchFailures(fi, HandleFailure);
  1551.         IF fPreferColor THEN
  1552.             IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  1553.                 BEGIN
  1554.                 { make the 'cicn' resource non-purgeable, so the Toolbox doesn't die }
  1555.                 itsRsrcHandle := GetResource('cicn', fRsrcID);
  1556.                 IF itsRsrcHandle <> NIL THEN
  1557.                     BEGIN
  1558.                     savedState := HGetState(itsRsrcHandle);
  1559.                     HNoPurge(itsRsrcHandle);
  1560.                     END;
  1561.                 
  1562.                 fDataHandle := Handle(GetCIcon(fRsrcID));
  1563.             
  1564.                 { restore the state of the 'cicn' resource }
  1565.                 IF itsRsrcHandle <> NIL THEN
  1566.                     HSetState(itsRsrcHandle, savedState);
  1567.                 END;
  1568.         IF fDataHandle = NIL THEN
  1569.             BEGIN
  1570.             fDataHandle := GetIcon(fRsrcID);
  1571.             IF fDataHandle <> NIL THEN
  1572.                 fPreferColor := NOT kPreferColor;        { Either can't or won't }
  1573.             END;
  1574.         { Don't die because resource not found - just return NIL handle }
  1575.         FailResError;
  1576.         Success(fi);
  1577.         END;
  1578.     fDefChoice := mIconHit;
  1579.  
  1580.     OffsetPtr(itsParams, SIZEOF(IconTemplate));
  1581.     END;
  1582.  
  1583. {--------------------------------------------------------------------------------------------------}
  1584. {$S MAWriteRes}
  1585.  
  1586. PROCEDURE TIcon.WRes(theResource: ViewRsrcHndl;
  1587.                      VAR itsParams: Ptr); OVERRIDE;
  1588.  
  1589.     VAR
  1590.         icPtr:                IconTemplatePtr;
  1591.  
  1592.     BEGIN
  1593.     INHERITED WRes(theResource, itsParams);
  1594.  
  1595.     icPtr := IconTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(IconTemplate)));
  1596.  
  1597.     WITH icPtr^ DO
  1598.         BEGIN
  1599.         preferColor := fPreferColor;
  1600.         {$IFC qDebug}
  1601.         IF fRsrcID = kNoResource THEN
  1602.             WRITELN('Tried to write TIcon with no resource ID.');
  1603.         {$ENDC}
  1604.         rsrcID := fRsrcID;
  1605.         END;
  1606.     END;
  1607.  
  1608. {--------------------------------------------------------------------------------------------------}
  1609. {$S MAWriteRes}
  1610.  
  1611. PROCEDURE TIcon.WriteRes(theResource: ViewRsrcHndl;
  1612.                          VAR itsParams: Ptr); OVERRIDE;
  1613.  
  1614.     BEGIN
  1615.     gWResSignature := 'icon'; gWResType := 'TIcon';
  1616.     WRes(theResource, itsParams);
  1617.     END;
  1618.  
  1619. {--------------------------------------------------------------------------------------------------}
  1620. {$S DlgClose}
  1621.  
  1622. PROCEDURE TIcon.Free; OVERRIDE;
  1623.  
  1624.     BEGIN
  1625.     ReleaseIcon;
  1626.  
  1627.     INHERITED Free;
  1628.     END;
  1629.  
  1630. {--------------------------------------------------------------------------------------------------}
  1631. {$S DlgRes}
  1632.  
  1633. PROCEDURE TIcon.Draw(area: Rect); OVERRIDE;
  1634.  
  1635.     VAR
  1636.         oldState: SignedByte;
  1637.         theRect: Rect;
  1638.         aPixMap: PixMap;
  1639.         aBitMapPtr: BitMapPtr;
  1640.         srcRect: Rect;
  1641.  
  1642.     BEGIN
  1643.     IF fDataHandle <> NIL THEN
  1644.         BEGIN
  1645.         IF fRsrcID <> kNoResource THEN
  1646.             LoadResource(fDataHandle);
  1647.         IF fDataHandle^ <> NIL THEN            { If there's room for the icon… }
  1648.             BEGIN
  1649.             PenNormal;                        { NECESSARY? }
  1650.             ControlArea(theRect);
  1651.             oldState := GetHandleBits(fDataHandle);
  1652.             HNoPurge(fDataHandle);
  1653.             HLock(fDataHandle);
  1654.  
  1655.             IF fPreferColor THEN
  1656.                 BEGIN
  1657.  
  1658.                 { We can't use PlotCIcon here because it can't be written to a picture }
  1659.                 { and when WriteToDeskScrap is called, the icon is plotted on the }
  1660.                 { desktop rather than in the picture.  So instead, pick apart the color }
  1661.                 { icon handle and use copybits, ignoring the mask. }
  1662.  
  1663.                 aPixMap := CIconHandle(fDataHandle)^^.iconPMap;
  1664.                 HLock(CIconHandle(fDataHandle)^^.iconData);
  1665.                 aPixMap.baseAddr := CIconHandle(fDataHandle)^^.iconData^;
  1666.                 srcRect := aPixMap.bounds;
  1667.                 aBitMapPtr := @aPixMap;
  1668.                 CopyBits(aBitMapPtr^, thePort^.portBits, srcRect, theRect, srcCopy, NIL);
  1669.                 HUnLock(CIconHandle(fDataHandle)^^.iconData);
  1670.                 END
  1671.             ELSE
  1672.                 PlotIcon(theRect, fDataHandle);
  1673.  
  1674.             SetHandleBits(fDataHandle, oldState);
  1675.             END;
  1676.         END;
  1677.  
  1678.     INHERITED Draw(area);
  1679.     END;
  1680.  
  1681. {--------------------------------------------------------------------------------------------------}
  1682. {$S DlgNonRes}
  1683.  
  1684. PROCEDURE TIcon.ReleaseIcon;
  1685.  
  1686.     BEGIN
  1687.     fRsrcID := kNoResource;
  1688.     IF fDataHandle <> NIL THEN
  1689.         BEGIN
  1690.         IF fPreferColor THEN
  1691.             DisposCIcon(CIconHandle(fDataHandle))
  1692.         ELSE
  1693.             HPurge(fDataHandle);
  1694.         fDataHandle := NIL;
  1695.         END;
  1696.     END;
  1697.  
  1698. {--------------------------------------------------------------------------------------------------}
  1699. {$S DlgNonRes}
  1700.  
  1701. PROCEDURE TIcon.SetIcon(theIcon: Handle;
  1702.                         redraw: BOOLEAN);
  1703.     CONST
  1704.         kBWIconSize         = 128;
  1705.  
  1706.     BEGIN
  1707.     ReleaseIcon;
  1708.     
  1709.     IF GetHandleSize(theIcon) <> kBWIconSize THEN
  1710.         fPreferColor := TRUE
  1711.     ELSE
  1712.         fPreferColor := FALSE;
  1713.         
  1714.     fDataHandle := theIcon;
  1715.     IF redraw THEN
  1716.         ForceRedraw;
  1717.     END;
  1718.  
  1719. {--------------------------------------------------------------------------------------------------}
  1720. {$S DlgFields}
  1721.  
  1722. PROCEDURE TIcon.Fields(PROCEDURE DoToField(fieldName: Str255;
  1723.                                            fieldAddr: Ptr;
  1724.                                            fieldType: INTEGER)); OVERRIDE;
  1725.  
  1726.     BEGIN
  1727.     DoToField('TIcon', NIL, bClass);
  1728.     DoToField('fPreferColor', @fPreferColor, bBoolean);
  1729.     DoToField('fRsrcID', @fRsrcID, bInteger);
  1730.     DoToField('fDataHandle', @fDataHandle, bHandle);
  1731.  
  1732.     INHERITED Fields(DoToField);
  1733.     END;
  1734.  
  1735. {--------------------------------------------------------------------------------------------------}
  1736. {$S DlgOpen}
  1737.  
  1738. PROCEDURE TPattern.IPattern(itsSuperView: TView;
  1739.                             itsLocation, itsSize: VPoint;
  1740.                             itsHSizeDet, itsVSizeDet: SizeDeterminer;
  1741.                             itsRsrcID: INTEGER;
  1742.                             preferColor: BOOLEAN);
  1743.  
  1744.     VAR
  1745.         fi:                 FailInfo;
  1746.  
  1747.     PROCEDURE HandleFailure(error: OSErr;
  1748.                             message: LONGINT);
  1749.  
  1750.         BEGIN
  1751.         Free;
  1752.         END;
  1753.  
  1754.     BEGIN
  1755.     fDataHandle := NIL;
  1756.     IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  1757.     fPreferColor := preferColor;
  1758.     fRsrcID := itsRsrcID;
  1759.     IF fRsrcID <> kNoResource THEN
  1760.         BEGIN
  1761.         CatchFailures(fi, HandleFailure);
  1762.         IF fPreferColor THEN
  1763.             IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  1764.                 fDataHandle := Handle(GetPixPat(fRsrcID));
  1765.         IF fDataHandle = NIL THEN
  1766.             BEGIN
  1767.             fDataHandle := Handle(GetPattern(fRsrcID));
  1768.             IF fDataHandle <> NIL THEN
  1769.                 fPreferColor := NOT kPreferColor;        { Either can't or won't }
  1770.             END;
  1771.         FailResError;
  1772.         Success(fi);
  1773.         END;
  1774.     ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
  1775.     fDefChoice := mPatternHit;
  1776.     END;
  1777.  
  1778. {--------------------------------------------------------------------------------------------------}
  1779. {$S DlgOpen}
  1780.  
  1781. PROCEDURE TPattern.IRes(itsDocument: TDocument;
  1782.                         itsSuperView: TView;
  1783.                         VAR itsParams: Ptr); OVERRIDE;
  1784.  
  1785.     VAR
  1786.         fi:                 FailInfo;
  1787.  
  1788.     PROCEDURE HandleFailure(error: OSErr;
  1789.                             message: LONGINT);
  1790.  
  1791.         BEGIN
  1792.         Free;
  1793.         END;
  1794.  
  1795.     BEGIN
  1796.     fDataHandle := NIL;
  1797.     INHERITED IRes(NIL, itsSuperView, itsParams);
  1798.  
  1799.     WITH PatternTemplatePtr(itsParams)^ DO
  1800.         BEGIN
  1801.         fPreferColor := preferColor;
  1802.         fRsrcID := rsrcID;
  1803.         END;
  1804.     IF fRsrcID <> kNoResource THEN
  1805.         BEGIN
  1806.         CatchFailures(fi, HandleFailure);
  1807.         IF fPreferColor THEN
  1808.             IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  1809.                 fDataHandle := Handle(GetPixPat(fRsrcID));
  1810.         IF fDataHandle = NIL THEN
  1811.             BEGIN
  1812.             fDataHandle := Handle(GetPattern(fRsrcID));
  1813.             IF fDataHandle <> NIL THEN
  1814.                 fPreferColor := NOT kPreferColor;        { Either can't or won't }
  1815.             END;
  1816.         FailResError;
  1817.         Success(fi);
  1818.         END;
  1819.     fDefChoice := mPatternHit;
  1820.  
  1821.     OffsetPtr(itsParams, SIZEOF(PatternTemplate));
  1822.     END;
  1823.  
  1824. {--------------------------------------------------------------------------------------------------}
  1825. {$S MAWriteRes}
  1826.  
  1827. PROCEDURE TPattern.WRes(theResource: ViewRsrcHndl;
  1828.                         VAR itsParams: Ptr); OVERRIDE;
  1829.  
  1830.     VAR
  1831.         ptPtr:                PatternTemplatePtr;
  1832.  
  1833.     BEGIN
  1834.     INHERITED WRes(theResource, itsParams);
  1835.  
  1836.     ptPtr := PatternTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(PatternTemplate)));
  1837.  
  1838.     WITH ptPtr^ DO
  1839.         BEGIN
  1840.         preferColor := fPreferColor;
  1841.         {$IFC qDebug}
  1842.         IF fRsrcID = kNoResource THEN
  1843.             WRITELN('Tried to write TPattern with no resource ID.');
  1844.         {$ENDC}
  1845.         rsrcID := fRsrcID;
  1846.         END;
  1847.     END;
  1848.  
  1849. {--------------------------------------------------------------------------------------------------}
  1850. {$S MAWriteRes}
  1851.  
  1852. PROCEDURE TPattern.WriteRes(theResource: ViewRsrcHndl;
  1853.                             VAR itsParams: Ptr); OVERRIDE;
  1854.  
  1855.     BEGIN
  1856.     gWResSignature := 'patn'; gWResType := 'TPattern';
  1857.     WRes(theResource, itsParams);
  1858.     END;
  1859.  
  1860. {--------------------------------------------------------------------------------------------------}
  1861. {$S DlgClose}
  1862.  
  1863. PROCEDURE TPattern.Free; OVERRIDE;
  1864.  
  1865.     BEGIN
  1866.     ReleasePattern;
  1867.  
  1868.     INHERITED Free;
  1869.     END;
  1870.  
  1871. {--------------------------------------------------------------------------------------------------}
  1872. {$S DlgRes}
  1873.  
  1874. PROCEDURE TPattern.Draw(area: Rect); OVERRIDE;
  1875.  
  1876.     VAR
  1877.         wasLocked:            BOOLEAN;
  1878.         theRect:            Rect;
  1879.  
  1880.     BEGIN
  1881.     IF fDataHandle <> NIL THEN
  1882.         BEGIN
  1883.         IF (fRsrcID <> kNoResource) & NOT fPreferColor THEN { Pixpat handles <> resource handles }
  1884.             LoadResource(fDataHandle);
  1885.         IF fDataHandle^ <> NIL THEN                     { If there's room for the pattern… }
  1886.             BEGIN
  1887.             PenNormal;                                    { NECESSARY? }
  1888.             ControlArea(theRect);
  1889.             wasLocked := IsHandleLocked(fDataHandle);    { Remember current lock state }
  1890.             IF NOT wasLocked THEN
  1891.                 HLock(fDataHandle);                     { Because FillRect may move memory }
  1892.             IF fPreferColor THEN
  1893.                 FillCRect(theRect, PixPatHandle(fDataHandle))
  1894.             ELSE
  1895.                 FillRect(theRect, PatHandle(fDataHandle)^^);
  1896.             IF NOT wasLocked THEN
  1897.                 HUnLock(fDataHandle);                    { restore handle's unlocked state }
  1898.             END
  1899.         END;
  1900.  
  1901.     INHERITED Draw(area);
  1902.     END;
  1903.  
  1904. {--------------------------------------------------------------------------------------------------}
  1905. {$S DlgNonRes}
  1906.  
  1907. PROCEDURE TPattern.ReleasePattern;
  1908.  
  1909.     BEGIN
  1910.     fRsrcID := kNoResource;
  1911.     IF fDataHandle <> NIL THEN
  1912.         BEGIN
  1913.         IF fPreferColor THEN
  1914.             DisposPixPat(PixPatHandle(fDataHandle))
  1915.         ELSE
  1916.             HPurge(fDataHandle);
  1917.         fDataHandle := NIL;
  1918.         END;
  1919.     END;
  1920.  
  1921. {--------------------------------------------------------------------------------------------------}
  1922. {$S DlgNonRes}
  1923.  
  1924. PROCEDURE TPattern.SetPattern(thePattern: Handle;
  1925.                               redraw: BOOLEAN);
  1926.  
  1927.     BEGIN
  1928.     ReleasePattern;
  1929.     fDataHandle := thePattern;
  1930.     IF redraw THEN
  1931.         ForceRedraw;
  1932.     END;
  1933.  
  1934. {--------------------------------------------------------------------------------------------------}
  1935. {$S DlgFields}
  1936.  
  1937. PROCEDURE TPattern.Fields(PROCEDURE DoToField(fieldName: Str255;
  1938.                                               fieldAddr: Ptr;
  1939.                                               fieldType: INTEGER)); OVERRIDE;
  1940.  
  1941.     BEGIN
  1942.     DoToField('TPattern', NIL, bClass);
  1943.     DoToField('fPreferColor', @fPreferColor, bBoolean);
  1944.     DoToField('fRsrcID', @fRsrcID, bInteger);
  1945.     DoToField('fDataHandle', @fDataHandle, bHandle);
  1946.  
  1947.     INHERITED Fields(DoToField);
  1948.     END;
  1949.  
  1950. {--------------------------------------------------------------------------------------------------}
  1951. {$S DlgOpen}
  1952.  
  1953. PROCEDURE TPicture.IPicture(itsSuperView: TView;
  1954.                             itsLocation, itsSize: VPoint;
  1955.                             itsHSizeDet, itsVSizeDet: SizeDeterminer;
  1956.                             itsRsrcID: INTEGER);
  1957.  
  1958.     VAR
  1959.         fi:                 FailInfo;
  1960.  
  1961.     PROCEDURE HandleFailure(error: OSErr;
  1962.                             message: LONGINT);
  1963.  
  1964.         BEGIN
  1965.         Free;
  1966.         END;
  1967.  
  1968.     BEGIN
  1969.     fDataHandle := NIL;
  1970.     IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  1971.     fRsrcID := itsRsrcID;
  1972.     IF fRsrcID <> kNoResource THEN
  1973.         BEGIN
  1974.         CatchFailures(fi, HandleFailure);
  1975.         fDataHandle := GetPicture(fRsrcID);
  1976.         FailResError;
  1977.         Success(fi);
  1978.         END;
  1979.     ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
  1980.     fDefChoice := mPictureHit;
  1981.     END;
  1982.  
  1983. {--------------------------------------------------------------------------------------------------}
  1984. {$S DlgOpen}
  1985.  
  1986. PROCEDURE TPicture.IRes(itsDocument: TDocument;
  1987.                         itsSuperView: TView;
  1988.                         VAR itsParams: Ptr); OVERRIDE;
  1989.  
  1990.     VAR
  1991.         fi:                 FailInfo;
  1992.  
  1993.     PROCEDURE HandleFailure(error: OSErr;
  1994.                             message: LONGINT);
  1995.  
  1996.         BEGIN
  1997.         Free;
  1998.         END;
  1999.  
  2000.     BEGIN
  2001.     fDataHandle := NIL;
  2002.     INHERITED IRes(NIL, itsSuperView, itsParams);
  2003.  
  2004.     fRsrcID := PictureTemplatePtr(itsParams)^.rsrcID;
  2005.     IF fRsrcID <> kNoResource THEN
  2006.         BEGIN
  2007.         CatchFailures(fi, HandleFailure);
  2008.         fDataHandle := GetPicture(fRsrcID);
  2009.         FailResError;
  2010.         Success(fi);
  2011.         END;
  2012.     fDefChoice := mPictureHit;
  2013.  
  2014.     OffsetPtr(itsParams, SIZEOF(PictureTemplate));
  2015.     END;
  2016.  
  2017. {--------------------------------------------------------------------------------------------------}
  2018. {$S MAWriteRes}
  2019.  
  2020. PROCEDURE TPicture.WRes(theResource: ViewRsrcHndl;
  2021.                         VAR itsParams: Ptr); OVERRIDE;
  2022.  
  2023.     VAR
  2024.         pcPtr:                PictureTemplatePtr;
  2025.  
  2026.     BEGIN
  2027.     INHERITED WRes(theResource, itsParams);
  2028.  
  2029.     pcPtr := PictureTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(PictureTemplate)));
  2030.  
  2031.     {$IFC qDebug}
  2032.     IF fRsrcID = kNoResource THEN
  2033.         WRITELN('Tried to write TPicture with no resource ID.');
  2034.     {$ENDC}
  2035.     pcPtr^.rsrcID := fRsrcID;
  2036.     END;
  2037.  
  2038. {--------------------------------------------------------------------------------------------------}
  2039. {$S MAWriteRes}
  2040.  
  2041. PROCEDURE TPicture.WriteRes(theResource: ViewRsrcHndl;
  2042.                             VAR itsParams: Ptr); OVERRIDE;
  2043.  
  2044.     BEGIN
  2045.     gWResSignature := 'pict'; gWResType := 'TPicture';
  2046.     WRes(theResource, itsParams);
  2047.     END;
  2048.  
  2049. {--------------------------------------------------------------------------------------------------}
  2050. {$S DlgClose}
  2051.  
  2052. PROCEDURE TPicture.Free; OVERRIDE;
  2053.  
  2054.     BEGIN
  2055.     ReleasePicture;
  2056.  
  2057.     INHERITED Free;
  2058.     END;
  2059.  
  2060. {--------------------------------------------------------------------------------------------------}
  2061. {$S DlgRes}
  2062.  
  2063. PROCEDURE TPicture.Draw(area: Rect); OVERRIDE;
  2064.  
  2065.     VAR
  2066.         oldState:            SignedByte;
  2067.         theRect:            Rect;
  2068.  
  2069.     BEGIN
  2070.     IF fDataHandle <> NIL THEN
  2071.         BEGIN
  2072.         IF fRsrcID <> kNoResource THEN
  2073.             LoadResource(Handle(fDataHandle));
  2074.         IF fDataHandle^ <> NIL THEN                     { If there's room for the picture… }
  2075.             BEGIN
  2076.             ControlArea(theRect);
  2077.             oldState := GetHandleBits(Handle(fDataHandle));
  2078.             HNoPurge(Handle(fDataHandle));
  2079.             PenNormal;                                    { ??? NECESSARY ??? }
  2080.             DrawPicture(fDataHandle, theRect);
  2081.             SetHandleBits(Handle(fDataHandle), oldState);
  2082.             END;
  2083.         END;
  2084.     INHERITED Draw(area);
  2085.     END;
  2086.  
  2087. {--------------------------------------------------------------------------------------------------}
  2088. {$S DlgNonRes}
  2089.  
  2090. PROCEDURE TPicture.ReleasePicture;
  2091.  
  2092.     BEGIN
  2093.     fRsrcID := kNoResource;
  2094.     IF fDataHandle <> NIL THEN
  2095.         BEGIN
  2096.         HPurge(Handle(fDataHandle));
  2097.         fDataHandle := NIL;
  2098.         END;
  2099.     END;
  2100.  
  2101. {--------------------------------------------------------------------------------------------------}
  2102. {$S DlgNonRes}
  2103.  
  2104. PROCEDURE TPicture.SetPicture(thePicture: PicHandle;
  2105.                               redraw: BOOLEAN);
  2106.  
  2107.     BEGIN
  2108.     ReleasePicture;
  2109.     fDataHandle := thePicture;
  2110.     IF redraw THEN
  2111.         ForceRedraw;
  2112.     END;
  2113.  
  2114. {--------------------------------------------------------------------------------------------------}
  2115. {$S DlgFields}
  2116.  
  2117. PROCEDURE TPicture.Fields(PROCEDURE DoToField(fieldName: Str255;
  2118.                                               fieldAddr: Ptr;
  2119.                                               fieldType: INTEGER)); OVERRIDE;
  2120.  
  2121.     BEGIN
  2122.     DoToField('TPicture', NIL, bClass);
  2123.     DoToField('fRsrcID', @fRsrcID, bInteger);
  2124.     DoToField('fDataHandle', @fDataHandle, bHandle);
  2125.  
  2126.     INHERITED Fields(DoToField);
  2127.     END;
  2128.  
  2129. {--------------------------------------------------------------------------------------------------}
  2130. {$S DlgOpen}
  2131.  
  2132. PROCEDURE TPopup.IPopup(itsSuperView: TView;
  2133.                         itsLocation, itsSize: VPoint;
  2134.                         itsHSizeDet, itsVSizeDet: SizeDeterminer;
  2135.                         itsRsrcID, itsCurrentItem, itsItemOffset: INTEGER);
  2136.  
  2137.     VAR
  2138.         fi:                 FailInfo;
  2139.         aMenu:                MenuHandle;
  2140.  
  2141.     PROCEDURE HandleFailure(error: OSErr;
  2142.                             message: LONGINT);
  2143.  
  2144.         BEGIN
  2145.         Free;
  2146.         END;
  2147.  
  2148.     BEGIN
  2149.     fMenuHandle := NIL;
  2150.     IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  2151.  
  2152.     IF qNeedsHierarchicalMenus | gConfiguration.hasHierarchicalMenus THEN
  2153.         BEGIN
  2154.         fCurrentItem := Max(1, itsCurrentItem);
  2155.         fItemOffset := itsItemOffset;
  2156.         IF itsRsrcID <> kNoResource THEN
  2157.             BEGIN
  2158.             CatchFailures(fi, HandleFailure);
  2159.             aMenu := GetMenu(itsRsrcID);
  2160.             { Don't die because resource not found - just return NIL handle }
  2161.             FailResError;
  2162.             HNoPurge(Handle(aMenu));
  2163.             SetPopup(aMenu, itsRsrcID, itsCurrentItem, False);
  2164.             Success(fi);
  2165.             END
  2166.         ELSE
  2167.             BEGIN
  2168.             fRsrcID := kNoResource;
  2169.             fMenuID := kNoResource;
  2170.             END;
  2171.         fDefChoice := mPopupHit;
  2172.         END
  2173.     ELSE
  2174.         BEGIN
  2175.         {$IFC qDebug}
  2176.         ProgramBreak('Attempt to use popup menus on machine that doesn''t support them');
  2177.         {$ENDC}
  2178.         fShown := False;                                { What's reasonable here ??? }
  2179.         END;
  2180.     END;
  2181.  
  2182. {--------------------------------------------------------------------------------------------------}
  2183. {$S DlgOpen}
  2184.  
  2185. PROCEDURE TPopup.IRes(itsDocument: TDocument;
  2186.                       itsSuperView: TView;
  2187.                       VAR itsParams: Ptr); OVERRIDE;
  2188.  
  2189.     VAR
  2190.         fi:                 FailInfo;
  2191.         aMenu:                MenuHandle;
  2192.  
  2193.     PROCEDURE HandleFailure(error: OSErr;
  2194.                             message: LONGINT);
  2195.  
  2196.         BEGIN
  2197.         Free;
  2198.         END;
  2199.  
  2200.     BEGIN
  2201.     fMenuHandle := NIL;
  2202.     INHERITED IRes(NIL, itsSuperView, itsParams);
  2203.  
  2204.     {$IFC NOT qNeedsHierarchicalMenus}
  2205.     IF NOT gConfiguration.hasHierarchicalMenus THEN
  2206.         BEGIN
  2207.         {$IFC qDebug}
  2208.         ProgramBreak('Attempt to use popup menus on machine that doesn''t support them');
  2209.         {$ENDC}
  2210.         fShown := False;                                { What's reasonable here ??? }
  2211.         END
  2212.     ELSE
  2213.     {$ENDC}
  2214.         BEGIN
  2215.         WITH PopupTemplatePtr(itsParams)^ DO
  2216.             BEGIN
  2217.             fCurrentItem := Max(1, currentItem);
  2218.             fItemOffset := itemOffset;
  2219.             fRsrcID := rsrcID;
  2220.             IF rsrcID <> kNoResource THEN
  2221.                 BEGIN
  2222.                 CatchFailures(fi, HandleFailure);
  2223.                 aMenu := GetMenu(rsrcID);
  2224.                 { Don't die because resource not found - just return NIL handle }
  2225.                 FailResError;
  2226.                 IF aMenu <> NIL THEN
  2227.                     HNoPurge(Handle(aMenu));
  2228.                 SetPopup(aMenu, rsrcID, fCurrentItem, False);
  2229.                 Success(fi);
  2230.                 END
  2231.             ELSE
  2232.                 fMenuID := kNoResource;
  2233.             END;
  2234.         fDefChoice := mPopupHit;
  2235.         END;
  2236.  
  2237.     OffsetPtr(itsParams, SIZEOF(PopupTemplate));
  2238.     END;
  2239.  
  2240. {--------------------------------------------------------------------------------------------------}
  2241. {$S MAWriteRes}
  2242.  
  2243. PROCEDURE TPopup.WRes(theResource: ViewRsrcHndl;
  2244.                       VAR itsParams: Ptr); OVERRIDE;
  2245.  
  2246.     VAR
  2247.         poPtr:                PopupTemplatePtr;
  2248.  
  2249.     BEGIN
  2250.     INHERITED WRes(theResource, itsParams);
  2251.  
  2252.     poPtr := PopupTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(PopupTemplate)));
  2253.  
  2254.     WITH poPtr^ DO
  2255.         BEGIN
  2256.         {$IFC qDebug}
  2257.         IF fRsrcID = kNoResource THEN
  2258.             ProgramBreak('Tried to write TPopup with no resource ID.');
  2259.         {$ENDC}
  2260.         rsrcID := fRsrcID;
  2261.         currentItem := fCurrentItem;
  2262.         itemOffset := fItemOffset;
  2263.         END;
  2264.     END;
  2265.  
  2266. {--------------------------------------------------------------------------------------------------}
  2267. {$S MAWriteRes}
  2268.  
  2269. PROCEDURE TPopup.WriteRes(theResource: ViewRsrcHndl;
  2270.                           VAR itsParams: Ptr); OVERRIDE;
  2271.  
  2272.     BEGIN
  2273.     gWResSignature := 'popp'; gWResType := 'TPopup';
  2274.     WRes(theResource, itsParams);
  2275.     END;
  2276.  
  2277. {--------------------------------------------------------------------------------------------------}
  2278. {$S DlgClose}
  2279.  
  2280. PROCEDURE TPopup.Free; OVERRIDE;
  2281.  
  2282.     BEGIN
  2283.     ReleasePopup;
  2284.  
  2285.     INHERITED Free;
  2286.     END;
  2287.  
  2288. {--------------------------------------------------------------------------------------------------}
  2289. {$S DlgOpen}
  2290.  
  2291. PROCEDURE TPopup.AdjustBotRight;
  2292.  
  2293.     VAR
  2294.         newHeight:            INTEGER;
  2295.         newWidth:            INTEGER;
  2296.         theFontInfo:        FontInfo;
  2297.  
  2298.     BEGIN
  2299.     IF fMenuHandle <> NIL THEN
  2300.         BEGIN
  2301.         CalcMenuSize(fMenuHandle);
  2302.         newWidth := fMenuHandle^^.menuWidth + fItemOffset + fInset.left + fInset.right + 3;
  2303.  
  2304.         GetTextStyleFontInfo(gSystemStyle, theFontInfo);
  2305.  
  2306.         WITH theFontInfo DO
  2307.             newHeight := ascent + descent + leading + fInset.top + fInset.bottom + 3;
  2308.  
  2309.         Resize(newWidth, newHeight, kDontInvalidate);
  2310.         END;
  2311.     END;
  2312.  
  2313. {--------------------------------------------------------------------------------------------------}
  2314. {$S DlgRes}
  2315.  
  2316. PROCEDURE TPopup.CalcLabelRect(VAR theRect: Rect);
  2317.  
  2318.     VAR
  2319.         theLabel:            Str255;
  2320.  
  2321.     BEGIN
  2322.     ControlArea(theRect);
  2323.     InsetRect(theRect, 1, 1);
  2324.     WITH theRect DO
  2325.         BEGIN
  2326.         right := left + fItemOffset - 1;                { adjust right }
  2327.         bottom := bottom - 1;                            { adjust bottom }
  2328.         theLabel := fMenuHandle^^.menuData;             { fetch the title of the menu }
  2329.         left := Max(left, right - StringWidth(theLabel) - 2); { adjust left }
  2330.         END;
  2331.     END;
  2332.  
  2333. {--------------------------------------------------------------------------------------------------}
  2334. {$S DlgRes}
  2335.  
  2336. PROCEDURE TPopup.CalcMenuRect(VAR theRect: Rect);
  2337.  
  2338.     BEGIN
  2339.     ControlArea(theRect);
  2340.     InsetRect(theRect, 1, 1);
  2341.     WITH theRect DO
  2342.         BEGIN
  2343.         left := left + fItemOffset;
  2344.         {WITH botRight DO
  2345.             BEGIN
  2346.             h := h - 1;
  2347.             v := v - 1;
  2348.             END;}
  2349.         END;
  2350.     END;
  2351.  
  2352. {--------------------------------------------------------------------------------------------------}
  2353. {$S DlgRes}
  2354.  
  2355. FUNCTION TPopup.DoMouseCommand(VAR theMouse: Point;
  2356.                                VAR info: EventInfo;
  2357.                                VAR hysteresis: Point): TCommand; OVERRIDE;
  2358.  
  2359.     VAR
  2360.         newChoice:            INTEGER;
  2361.         result:             LONGINT;
  2362.         menuPt:             Point;
  2363.         aMenuHandle:        MenuHandle;
  2364.         labelRect:            Rect;
  2365.         menuRect:            Rect;
  2366.         oldFColor:            RGBColor;
  2367.         oldBkColor:         RGBColor;
  2368.         newFColor:            RGBColor;
  2369.         newBkColor:         RGBColor;
  2370.         fi:                 FailInfo;
  2371.  
  2372.     PROCEDURE HandleFailure(error: OSErr;
  2373.                             message: LONGINT);
  2374.  
  2375.         BEGIN
  2376.         DeleteMenu(fMenuID);
  2377.         SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
  2378.         END;
  2379.  
  2380.     BEGIN
  2381.     DoMouseCommand := NIL;
  2382.     CalcLabelRect(labelRect);
  2383.     CalcMenuRect(menuRect);                             { ??? test if theMouse is in menuRect ??? }
  2384.  
  2385.     IF fMenuHandle <> NIL THEN
  2386.         BEGIN
  2387.         MAInsertMenu(fMenuHandle, hierMenu);            { MAInsertMenu ensures colors are set }
  2388.         { Save the old colors, fetch the item colors, and draw the popup box }
  2389.         GetIfColor(oldFColor); GetIfBkColor(oldBkColor);
  2390.         GetMenuColors(menuRect, fMenuID, 0, newFColor, newBkColor);
  2391.         SetIfColor(newBkColor); SetIfBkColor(newFColor);
  2392.         DrawLabel(labelRect);
  2393.  
  2394.         IF (fRsrcID <> kNoResource) THEN
  2395.             IF qNeedsColorQD | gConfiguration.hasColorQD THEN
  2396.                 aMenuHandle := GetResMenu(fRsrcID);     { Reloads color tables! }
  2397.         WITH menuRect DO
  2398.             SetPt(menuPt, left, top);                     { Don't overwrite stuff next to the label }
  2399.         LocalToGlobal(menuPt);
  2400.         CalcMenuSize(fMenuHandle);                        { Fix for Menu Manager bug }
  2401.  
  2402.         SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
  2403.         InsetRect(menuRect, - 1, - 1);
  2404.         EraseRect(menuRect);
  2405.  
  2406.         result := PopUpMenuSelect(fMenuHandle, menuPt.v, menuPt.h, fCurrentItem);
  2407.         newChoice := LoWord(result);
  2408.         SetIfColor(newFColor); SetIfBkColor(newBkColor);
  2409.         DrawLabel(labelRect);
  2410.         IF (HiWord(result) <> 0) & (newChoice <> fCurrentItem) THEN
  2411.             BEGIN
  2412.             SetCurrentItem(newChoice, kRedraw);
  2413.             CatchFailures(fi, HandleFailure);
  2414.             DoChoice(SELF, fDefChoice);
  2415.             Success(fi);
  2416.             END
  2417.         ELSE
  2418.             SetCurrentItem(fCurrentItem, kRedraw);
  2419.         DeleteMenu(fMenuID);
  2420.         SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
  2421.         END;
  2422.     END;
  2423.  
  2424. {--------------------------------------------------------------------------------------------------}
  2425. {$S DlgRes}
  2426.  
  2427. PROCEDURE TPopup.Draw(area: Rect); OVERRIDE;
  2428.  
  2429.     VAR
  2430.         aRect:                Rect;
  2431.         oldFColor:            RGBColor;
  2432.         oldBkColor:         RGBColor;
  2433.         newFColor:            RGBColor;
  2434.         newBkColor:         RGBColor;
  2435.  
  2436.     BEGIN
  2437.     IF fMenuHandle <> NIL THEN
  2438.         BEGIN
  2439.         MAInsertMenu(fMenuHandle, hierMenu);            { MAInsertMenu ensures colors are set }
  2440.         { Erase the whole menu first }
  2441.         ControlArea(aRect);
  2442.         IF SectRect(area, aRect, aRect) THEN
  2443.             BEGIN
  2444.             { EraseRect(aRect); }
  2445.  
  2446.             { Save the old colors, fetch the item colors, and draw the popup box }
  2447.             GetIfColor(oldFColor); GetIfBkColor(oldBkColor);
  2448.             CalcMenuRect(aRect);
  2449.             GetMenuColors(aRect, fMenuID, fCurrentItem, newFColor, newBkColor);
  2450.             SetIfColor(newFColor); SetIfBkColor(newBkColor);
  2451.             DrawPopupBox(area);
  2452.  
  2453.             { Fetch the title colors, and draw it }
  2454.             GetMenuColors(aRect, fMenuID, 0, newFColor, newBkColor);
  2455.             SetIfColor(newFColor); SetIfBkColor(newBkColor);
  2456.             DrawLabel(area);
  2457.  
  2458.             { Reset colors to their original state }
  2459.             SetIfColor(oldFColor); SetIfBkColor(oldBkColor);
  2460.             END;
  2461.         DeleteMenu(fMenuID);
  2462.         END;
  2463.  
  2464.     INHERITED Draw(area);
  2465.     END;
  2466.  
  2467. {--------------------------------------------------------------------------------------------------}
  2468. {$S DlgRes}
  2469.  
  2470. PROCEDURE TPopup.DrawLabel(area: Rect);
  2471.  
  2472.     VAR
  2473.         labelRect:            Rect;
  2474.         theLabel:            Str255;
  2475.  
  2476.     BEGIN
  2477.     CalcLabelRect(labelRect);
  2478.     IF SectRect(area, labelRect, area) THEN
  2479.         BEGIN
  2480.  
  2481.         {$IFC qDebug}
  2482.         AssumeFocused;
  2483.         {$ENDC}
  2484.  
  2485.         theLabel := fMenuHandle^^.menuData;             { Fetch the title of the menu }
  2486.         IF Length(theLabel) > 0 THEN
  2487.             BEGIN
  2488.             EraseRect(labelRect);                { Might be switching colors }
  2489.             MADrawString(@theLabel, labelRect, teJustSystem);
  2490.             END;
  2491.         END;
  2492.     END;
  2493.  
  2494. {--------------------------------------------------------------------------------------------------}
  2495. {$S DlgRes}
  2496.  
  2497. PROCEDURE TPopup.DrawPopupBox(area: Rect);
  2498.  
  2499.     CONST
  2500.         ShadowedFrame        = [adnLineTop, adnLineLeft, adnLineBottom, adnLineRight, adnShadow];
  2501.         leftSlop            = 15;                        { should be 13 to image like it used to
  2502.                                                         (off by 2 pixels)  at 15 it images exactly
  2503.                                                         the same when popped up or not. }
  2504.         rightSlop            = 1;
  2505.         botSlop             = 6;
  2506.         kMinWidth            = 0;
  2507.  
  2508.     VAR
  2509.         wid:                INTEGER;
  2510.         newWid:             INTEGER;
  2511.         newLen:             INTEGER;
  2512.         menuRect:            Rect;
  2513.         colorRect:            Rect;
  2514.         theItemRect:        Rect;
  2515.         theItem:            Str255;
  2516.         theFontInfo:        FontInfo;
  2517.  
  2518.     BEGIN
  2519.     CalcMenuRect(menuRect);
  2520.     GetItem(fMenuHandle, fCurrentItem, theItem);
  2521.     WITH menuRect DO
  2522.         BEGIN
  2523.         IF NOT EmptyRect(menuRect) THEN
  2524.             BEGIN
  2525.             InsetRect(menuRect, - 1, - 1);
  2526.             IF SectRect(area, menuRect, colorRect) THEN
  2527.                 BEGIN
  2528.                 IF (theItem <> '') THEN
  2529.                     BEGIN
  2530.                     wid := Max(kMinWidth, (right - left) - (leftSlop + rightSlop));
  2531.                     newWid := StringWidth(theItem);
  2532.                     IF newWid > wid THEN
  2533.                         BEGIN
  2534.                         newLen := Length(theItem);
  2535.     
  2536.                         REPEAT
  2537.                             theItem[newLen] := '…';
  2538.                             theItem[0] := CHR(newLen);
  2539.                             newWid := StringWidth(theItem);
  2540.                             newLen := PRED(newLen);
  2541.                         UNTIL (newWid <= wid) | (newLen = 0);
  2542.     
  2543.                         END;
  2544.                     END;
  2545.  
  2546.                 PenNormal;
  2547.  
  2548.                 {$IFC qDebug}
  2549.                 AssumeFocused;
  2550.                 {$ENDC}
  2551.  
  2552.                 WITH colorRect DO
  2553.                     BEGIN
  2554.                     right := MIN(right, menuRect.right - 1);
  2555.                     bottom := MIN(bottom, menuRect.bottom - 1);
  2556.                     END;
  2557.                 EraseRect(colorRect);                    { this "paints" the background }
  2558.  
  2559.                 GetFontInfo(theFontInfo);
  2560.                 WITH theFontInfo DO
  2561.                     SetRect(theItemRect, left + leftSlop, bottom -
  2562.                             botSlop - ascent,  { top computed based on the bottom - text
  2563.                                                              height }
  2564.                             right - rightSlop, bottom - botSlop + descent);
  2565.                 MADrawString(@theItem, theItemRect, teJustSystem);
  2566.  
  2567.                 SetIfColor(gRGBBlack);
  2568.                 WITH botRight DO
  2569.                     BEGIN
  2570.                     h := h - 1;
  2571.                     v := v - 1;
  2572.                     END;
  2573.                 FrameRect(menuRect);
  2574.                 MoveTo(left + 3, bottom);
  2575.                 LineTo(right, bottom);
  2576.                 LineTo(right, top + 3);
  2577.                 END;
  2578.             END;
  2579.         END;
  2580.     END;
  2581.  
  2582. {--------------------------------------------------------------------------------------------------}
  2583. {$S DlgNonRes}
  2584.  
  2585. FUNCTION TPopup.GetCurrentItem: INTEGER;
  2586.  
  2587.     BEGIN
  2588.     GetCurrentItem := fCurrentItem;
  2589.     END;
  2590.  
  2591. {--------------------------------------------------------------------------------------------------}
  2592. {$S DlgNonRes}
  2593.  
  2594. PROCEDURE TPopup.GetItemText(item: INTEGER;
  2595.                              VAR theText: Str255);
  2596.  
  2597.     BEGIN
  2598.     IF fMenuHandle <> NIL THEN
  2599.         GetItem(fMenuHandle, item, theText)
  2600.     ELSE
  2601.         theText := '';
  2602.     END;
  2603.  
  2604. {--------------------------------------------------------------------------------------------------}
  2605. {$S DlgNonRes}
  2606.  
  2607. PROCEDURE TPopup.ReleasePopup;
  2608.  
  2609.     BEGIN
  2610.     IF fMenuHandle <> NIL THEN
  2611.         BEGIN
  2612.         DisposeMenu(fMenuHandle);
  2613.         fMenuHandle := NIL;
  2614.         END;
  2615.     fMenuID := kNoResource;
  2616.     fCurrentItem := 0;
  2617.     END;
  2618.  
  2619. {--------------------------------------------------------------------------------------------------}
  2620. {$S DlgNonRes}
  2621.  
  2622. PROCEDURE TPopup.SetCurrentItem(item: INTEGER;
  2623.                                 redraw: BOOLEAN);
  2624.  
  2625.     VAR
  2626.         menuRect:            Rect;
  2627.         newFColor:            RGBColor;
  2628.         newBkColor:         RGBColor;
  2629.  
  2630.     BEGIN
  2631.     IF (fMenuHandle <> NIL) & (item <> fCurrentItem) THEN
  2632.         BEGIN
  2633.         IF fCurrentItem <> 0 THEN
  2634.             SetItemMark(fMenuHandle, fCurrentItem, ' ');
  2635.         IF item <> 0 THEN
  2636.             SetItemMark(fMenuHandle, item, CHR(checkMark));
  2637.         fCurrentItem := item;
  2638.         END;
  2639.     IF redraw & Focus & IsVisible THEN
  2640.         BEGIN
  2641.         GetQDExtent(menuRect);
  2642.         GetMenuColors(menuRect, fMenuID, item, newFColor, newBkColor);
  2643.         SetIfColor(newFColor); SetIfBkColor(newBkColor);
  2644.         DrawPopupBox(menuRect);
  2645.         END;
  2646.     END;
  2647.  
  2648. {--------------------------------------------------------------------------------------------------}
  2649. {$S DlgRes}
  2650.  
  2651. PROCEDURE TPopup.SetPopup(theMenu: MenuHandle;
  2652.                           theRsrcID, currentItem: INTEGER;
  2653.                           redraw: BOOLEAN);
  2654.  
  2655.     VAR
  2656.         fi:                 FailInfo;
  2657.  
  2658.     PROCEDURE HandleFailure(error: OSErr;
  2659.                             message: LONGINT);
  2660.  
  2661.         BEGIN
  2662.         Free;
  2663.         END;
  2664.  
  2665.     BEGIN
  2666.     ReleasePopup;
  2667.     IF theMenu <> NIL THEN
  2668.         BEGIN
  2669.         IF theRsrcID <> kNoResource THEN
  2670.             BEGIN
  2671.             CatchFailures(fi, HandleFailure);
  2672.             DetachResource(Handle(theMenu));
  2673.             FailResError;
  2674.             Success(fi);
  2675.             END;
  2676.         fMenuHandle := theMenu;
  2677.         fMenuID := theMenu^^.menuID;
  2678.         END;
  2679.     fRsrcID := theRsrcID;
  2680.     SetCurrentItem(Max(1, currentItem), kDontRedraw);
  2681.     AdjustBotRight;
  2682.     IF redraw THEN
  2683.         ForceRedraw;
  2684.     END;
  2685.  
  2686. {--------------------------------------------------------------------------------------------------}
  2687. {$S DlgFields}
  2688.  
  2689. PROCEDURE TPopup.Fields(PROCEDURE DoToField(fieldName: Str255;
  2690.                                             fieldAddr: Ptr;
  2691.                                             fieldType: INTEGER)); OVERRIDE;
  2692.  
  2693.     BEGIN
  2694.     DoToField('TPopup', NIL, bClass);
  2695.     DoToField('fRsrcID', @fRsrcID, bInteger);
  2696.     DoToField('fMenuID', @fMenuID, bInteger);
  2697.     DoToField('fMenuHandle', @fMenuHandle, bHandle);
  2698.     DoToField('fCurrentItem', @fCurrentItem, bInteger);
  2699.     DoToField('fItemOffset', @fItemOffset, bInteger);
  2700.  
  2701.     INHERITED Fields(DoToField);
  2702.     END;
  2703.  
  2704. {--------------------------------------------------------------------------------------------------}
  2705. {$S TEOpen}
  2706.  
  2707. PROCEDURE TDialogTEView.IDialogTEView(itsDocument: TDocument; itsSuperView: TView; itsLocation,
  2708.                                       itsSize: VPoint; itsHDeterminer,
  2709.                                       itsVDeterminer: SizeDeterminer; itsInset: Rect;
  2710.                                       itsTextStyle: TextStyle; itsJustification: INTEGER;
  2711.                                       itsStyleType, itsAutoWrap: BOOLEAN);
  2712.  
  2713.     BEGIN
  2714.     fEditText := NIL; { We don't own this reference but we don't want an invalid one either }
  2715.     fScroller := NIL;
  2716.  
  2717.     ITEView(itsDocument, itsSuperView, itsLocation, itsSize, itsHDeterminer, itsVDeterminer,
  2718.             itsInset, itsTextStyle, itsJustification, itsStyleType, itsAutoWrap);
  2719.  
  2720.     fFreeText := TRUE;
  2721.     
  2722.     fScroller := MakeScroller;
  2723.     IF fScroller <> NIL THEN
  2724.         fScroller.AddSubView(SELF);
  2725.     END;
  2726.  
  2727. {--------------------------------------------------------------------------------------------------}
  2728. {$S TEOpen}
  2729.  
  2730. PROCEDURE TDialogTEView.IRes(itsDocument: TDocument;
  2731.                              itsSuperView: TView;
  2732.                              VAR itsParams: Ptr); OVERRIDE;
  2733.  
  2734.  
  2735.     BEGIN
  2736.     fEditText := NIL;                                    { We don't own this reference but we don't
  2737.                                                          want an invalid one either }
  2738.     fScroller := NIL;
  2739.     INHERITED IRes(itsDocument, itsSuperView, itsParams);
  2740.  
  2741.     fScroller := MakeScroller;
  2742.     IF fScroller <> NIL THEN
  2743.         fScroller.AddSubView(SELF);
  2744.     END;
  2745.  
  2746. {--------------------------------------------------------------------------------------------------}
  2747. {$S TEClose}
  2748.  
  2749. PROCEDURE TDialogTEView.Free; OVERRIDE;
  2750.  
  2751.  
  2752.     BEGIN
  2753.     if fScroller <> NIL THEN
  2754.         BEGIN
  2755.         fScroller.RemoveSubView(SELF);
  2756.         FreeIfObject(fScroller);
  2757.         fScroller := NIL;
  2758.         END;
  2759.  
  2760.     INHERITED Free;
  2761.     END;
  2762.  
  2763. {--------------------------------------------------------------------------------------------------}
  2764. {$S DlgFields}
  2765.  
  2766. PROCEDURE TDialogTEView.Fields(PROCEDURE DoToField(fieldName: Str255;
  2767.                                                    fieldAddr: Ptr;
  2768.                                                    fieldType: INTEGER)); OVERRIDE;
  2769.  
  2770.     BEGIN
  2771.     DoToField('TDialogTEView', NIL, bClass);
  2772.     DoToField('fEditText', @fEditText, bObject);
  2773.     DoToField('fScroller', @fScroller, bObject);
  2774.  
  2775.     INHERITED Fields(DoToField);
  2776.     END;
  2777.  
  2778. {--------------------------------------------------------------------------------------------------}
  2779. {$S DlgNonRes}
  2780.  
  2781. PROCEDURE TDialogTEView.InstallEditText(theEditText: TEditText;
  2782.                                         selectChars: BOOLEAN);
  2783.  
  2784.     VAR
  2785.         theText:            Str255;
  2786.         aTextStyle:         TextStyle;
  2787.         theControlArea:     Rect;
  2788.         validExtent:        VRect;
  2789.         hadPendingUpdate:    Boolean;
  2790.  
  2791.     BEGIN
  2792.     IF fEditText <> NIL THEN
  2793.         BEGIN
  2794.         fEditText.RemoveSubView(fScroller);
  2795.         fEditText := NIL;
  2796.         END;
  2797.  
  2798.     IF theEditText <> NIL THEN
  2799.         BEGIN
  2800.         fControlChars := theEditText.fControlChars;
  2801.         fMaxChars := theEditText.fMaxChars;
  2802.         fInset := gZeroRect;
  2803.         hadPendingUpdate := theEditText.HasPendingUpdate;
  2804.  
  2805.         SetJustification(theEditText.fJust, kDontRedraw);
  2806.         ChangeWrap(theEditText.fAutoWrap, kDontRedraw);
  2807.  
  2808.         aTextStyle := theEditText.fTextStyle;
  2809.         SetOneStyle(0, 0, doAll, aTextStyle, kDontRedraw);
  2810.  
  2811.         theEditText.ControlArea(theControlArea);
  2812.  
  2813.         theEditText.AddSubView(fScroller);{ my scroller }
  2814.  
  2815.         IF fAutoWrap THEN
  2816.             fSizeDeterminer[h] := sizeSuperView
  2817.         ELSE
  2818.             fSizeDeterminer[h] := sizeVariable;    { Let the width vary with the number of characters }
  2819.  
  2820.         WITH theControlArea DO
  2821.             BEGIN
  2822.             fSuperView.Resize(right - left, bottom - top, kDontInvalidate);
  2823.             fSuperView.Locate(left, top, kDontInvalidate);
  2824.             END;
  2825.  
  2826.         theEditText.GetText(theText);
  2827.         SetText(theText);
  2828.         RecalcText;
  2829.         SynchView(kDontRedraw);
  2830.         AdjustSize;
  2831.  
  2832.     { Make the scroller's thinking match the display that the user already sees }
  2833.         fScroller.fTranslation.h := 0;
  2834.         CASE GetActualJustification(fJustification) OF
  2835.             teJustLeft, teForceLeft:
  2836.                 fScroller.fTranslation.v := 0;
  2837.             teJustRight:    { Right brain thinkers… left brain thinkers?? }
  2838.                 TScroller(fSuperView).fTranslation.h := fScroller.fMaxTranslation.h;
  2839.             teJustCenter:
  2840.                 fScroller.fTranslation.h := fScroller.fMaxTranslation.h DIV 2;
  2841.             END;
  2842.         theEditText.InvalidateFocus;
  2843.  
  2844.         IF selectChars THEN
  2845.             SetSelect(0, MAXINT, fHTE)
  2846.         ELSE
  2847.             SetSelect(0, 0, fHTE);                        { Caller will set the selection. }
  2848.  
  2849.         BeInScroller(fScroller);
  2850.  
  2851.     { Make my enable and my scroller's enable match my new superview }
  2852.     ViewEnable(theEditText.IsViewEnabled, kDontRedraw);
  2853.     fScroller.ViewEnable(theEditText.IsViewEnabled, kDontRedraw);
  2854.     fScroller.fRespondsToFunctionKeys := FALSE;            { !!! need a better way to let enclosing
  2855.                                                         dialog scroll by function keys if necessary }
  2856.  
  2857.     { Revalidate my extent to eliminate the flicker created by resizing the scrollers }
  2858.         IF NOT hadPendingUpdate & Focus THEN
  2859.             BEGIN
  2860.             GetExtent(validExtent);
  2861.             ValidVRect(validExtent);
  2862.             END;
  2863.         END;
  2864.  
  2865.     fEditText := theEditText;
  2866.     END;
  2867.  
  2868. {--------------------------------------------------------------------------------------------------}
  2869. {$S DlgNonRes}
  2870.  
  2871. PROCEDURE TDialogTEView.InstallSelection(wasActive, beActive: BOOLEAN); OVERRIDE;
  2872.  
  2873.     BEGIN
  2874.  { If we're deselecting a field and it's been scrolled, invalidate it
  2875.   so that it is redrawn correctly.}
  2876.     IF NOT beActive THEN
  2877.         IF fScroller.fTranslation.v <> 0 THEN
  2878.             ForceRedraw
  2879.         ELSE
  2880.             CASE GetActualJustification(fJustification) OF
  2881.                 teJustLeft, teForceLeft:
  2882.                     BEGIN
  2883.                     IF fScroller.fTranslation.h <> 0 THEN
  2884.                         ForceRedraw;
  2885.                     END;
  2886.                 teJustRight:
  2887.                     BEGIN
  2888.                     IF fScroller.fTranslation.h <> fScroller.fMaxTranslation.h THEN
  2889.                         ForceRedraw;
  2890.                     END;
  2891.                 teJustCenter:
  2892.                     BEGIN
  2893.                     IF fScroller.fTranslation.h <> (fScroller.fMaxTranslation.h DIV 2) THEN
  2894.                         ForceRedraw;
  2895.                     END;
  2896.             END;
  2897.  
  2898.     INHERITED InstallSelection(wasActive, beActive);
  2899.     END;
  2900.  
  2901. {--------------------------------------------------------------------------------------------------}
  2902. {$S DlgNonRes}
  2903.  
  2904. PROCEDURE TDialogTEView.ComputeSize(VAR newSize: VPoint); OVERRIDE;
  2905.  
  2906.     BEGIN
  2907.     INHERITED ComputeSize(newSize);
  2908.     
  2909.     IF NOT fAutoWrap  THEN
  2910.         CASE fSizeDeterminer[h] OF
  2911.             sizeVariable:
  2912.                 { TTEView already computed the variable size, bump it up to at leat the scroller's
  2913.                 size so that the cursor is claimed for the EditText and the user can click anywhere. }
  2914.                 IF NOT fStyleType THEN
  2915.                     newSize.h := Max(fScroller.fSize.h, newSize.h);
  2916.         END;
  2917.     END;
  2918.  
  2919. {--------------------------------------------------------------------------------------------------}
  2920. {$S TEOpen}
  2921.  
  2922. FUNCTION TDialogTEView.MakeScroller: TScroller;
  2923. { Must return a scroller.  !!! enhance the TDialogTEView to be able to function without a scroller }
  2924.     VAR
  2925.         aScroller: TScroller;
  2926.  
  2927.     BEGIN
  2928.     aScroller := NIL;
  2929.     New(aScroller);
  2930.     FailNil(aScroller);
  2931.     aScroller.IScroller(NIL, gZeroVPt, gZeroVPt, sizeRelSuperView, sizeRelSuperView, 0, 0,
  2932.                         NOT kWantHScrollBar, NOT kWantVScrollBar);
  2933.     MakeScroller := aScroller;
  2934.     END;
  2935.  
  2936. {--------------------------------------------------------------------------------------------------}
  2937. {$S DlgOpen}
  2938.  
  2939. PROCEDURE TStaticText.IStaticText(itsSuperView: TView;
  2940.                                   itsLocation, itsSize: VPoint;
  2941.                                   itsHSizeDet, itsVSizeDet: SizeDeterminer;
  2942.                                   itsRsrcID, itsIndex: INTEGER);
  2943.  
  2944.     VAR
  2945.         aString:            Str255;
  2946.         fi:                 FailInfo;
  2947.  
  2948.     PROCEDURE HandleFailure(error: OSErr;
  2949.                             message: LONGINT);
  2950.  
  2951.         BEGIN
  2952.         Free;
  2953.         END;
  2954.  
  2955.     BEGIN
  2956.     fDataHandle := NIL;
  2957.     IControl(itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
  2958.     fRsrcID := itsRsrcID;
  2959.     fIndex := itsIndex;
  2960.     fJust := teJustSystem;                                { Default to system justification }
  2961.     fAutoWrap := TRUE;                                    { Default to compatibility with 2.0 }
  2962.     IF fRsrcID <> kNoResource THEN
  2963.         BEGIN
  2964.         CatchFailures(fi, HandleFailure);
  2965.         GetIndString(aString, fRsrcID, fIndex);
  2966.         FailResError;
  2967.         Success(fi);
  2968.         SetText(aString, kDontRedraw);
  2969.         END;
  2970.     ViewEnable(False, kDontRedraw);                     { Default is to not enable hit testing }
  2971.     fDefChoice := mStaticTextHit;
  2972.     END;
  2973.  
  2974. {--------------------------------------------------------------------------------------------------}
  2975. {$S DlgOpen}
  2976.  
  2977. PROCEDURE TStaticText.IRes(itsDocument: TDocument;
  2978.                            itsSuperView: TView;
  2979.                            VAR itsParams: Ptr); OVERRIDE;
  2980.  
  2981.     BEGIN
  2982.     fRsrcID := kNoResource;
  2983.     fIndex := 0;
  2984.     fDataHandle := NIL;
  2985.     INHERITED IRes(NIL, itsSuperView, itsParams);
  2986.  
  2987.     fAutoWrap := TRUE;                                    { Default to compatibility with 2.0 }
  2988.     fDefChoice := mStaticTextHit;
  2989.     WITH StaticTextTemplatePtr(itsParams)^ DO
  2990.         BEGIN
  2991.         fJust := just;
  2992.         SetText(data, kDontRedraw);
  2993.         END;
  2994.  
  2995.     OffsetPtrWStr(itsParams, SIZEOF(StaticTextTemplate));
  2996.     END;
  2997.  
  2998. {--------------------------------------------------------------------------------------------------}
  2999. {$S MAWriteRes}
  3000.  
  3001. PROCEDURE TStaticText.WRes(theResource: ViewRsrcHndl;
  3002.                            VAR itsParams: Ptr); OVERRIDE;
  3003.  
  3004.     VAR
  3005.         theText:            Str255;
  3006.         stPtr:                StaticTextTemplatePtr;
  3007.  
  3008.     BEGIN
  3009.     INHERITED WRes(theResource, itsParams);
  3010.  
  3011.     GetText(theText);
  3012.  
  3013.     stPtr := StaticTextTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(StaticTextTemplate),
  3014.                                                  Length(theText)));
  3015.  
  3016.     WITH stPtr^ DO
  3017.         BEGIN
  3018.         just := fJust;
  3019.         { data := theText; }
  3020.         CopyStr255(theText, PRStr(data));
  3021.         END;
  3022.     END;
  3023.  
  3024. {--------------------------------------------------------------------------------------------------}
  3025. {$S MAWriteRes}
  3026.  
  3027. PROCEDURE TStaticText.WriteRes(theResource: ViewRsrcHndl;
  3028.                                VAR itsParams: Ptr); OVERRIDE;
  3029.  
  3030.     BEGIN
  3031.     gWResSignature := 'stat'; gWResType := 'TStaticText';
  3032.     WRes(theResource, itsParams);
  3033.     END;
  3034.  
  3035. {--------------------------------------------------------------------------------------------------}
  3036. {$S DlgClose}
  3037.  
  3038. PROCEDURE TStaticText.Free; OVERRIDE;
  3039.  
  3040.     BEGIN
  3041.     ReleaseText;
  3042.  
  3043.     INHERITED Free;
  3044.     END;
  3045.  
  3046. {--------------------------------------------------------------------------------------------------}
  3047. {$S DlgRes}
  3048.  
  3049. PROCEDURE TStaticText.ChangeWrap(newAutoWrap, redraw: BOOLEAN);
  3050.  
  3051.     BEGIN
  3052.     fAutoWrap := newAutoWrap;
  3053.     IF Redraw THEN
  3054.         ForceRedraw;
  3055.     END;
  3056.  
  3057. {--------------------------------------------------------------------------------------------------}
  3058. {$S DlgRes}
  3059.  
  3060. PROCEDURE TStaticText.DoSubstitution(VAR theText: Str255);
  3061.  
  3062.     VAR
  3063.         aDialogView:        TDialogView;
  3064.  
  3065.     BEGIN
  3066.     aDialogView := TDialogView(GetDialogView);
  3067.     IF aDialogView <> NIL THEN
  3068.         aDialogView.ReplaceText(theText);
  3069.     END;
  3070.  
  3071. {--------------------------------------------------------------------------------------------------}
  3072. {$S DlgRes}
  3073.  
  3074. PROCEDURE TStaticText.Draw(area: Rect); OVERRIDE;
  3075.  
  3076.     VAR
  3077.         theRect:            Rect;
  3078.         oldColor:            RGBColor;
  3079.         theText:            Str255;
  3080.         aTextStyle:         TextStyle;
  3081.  
  3082.     BEGIN
  3083.     IF fDataHandle <> NIL THEN
  3084.         BEGIN
  3085.         GetText(theText);
  3086.         DoSubstitution(theText);                        { Make the substitution if desired }
  3087.         ControlArea(theRect);
  3088.         PenNormal;                                        { ??? NECESSARY ??? }
  3089.         GetIfColor(oldColor);
  3090.         aTextStyle := fTextStyle;
  3091.         SetPortTextStyle(aTextStyle);
  3092.         ImageText(Ptr(ORD4(@theText) + 1), Length(theText), theRect, fJust);
  3093.         SetIfColor(oldColor);
  3094.         END;
  3095.     INHERITED Draw(area);
  3096.     END;
  3097.  
  3098. {--------------------------------------------------------------------------------------------------}
  3099. {$S DlgRes}
  3100.  
  3101. PROCEDURE TStaticText.GetText(VAR theText: Str255);
  3102.  
  3103.     BEGIN
  3104.     IF fDataHandle <> NIL THEN
  3105.     { theText := fDataHandle^^ }
  3106.         CopyStr255(fDataHandle^^, @theText)
  3107.     ELSE
  3108.         theText := '';
  3109.     END;
  3110.  
  3111. {--------------------------------------------------------------------------------------------------}
  3112. {$S DlgRes}
  3113.  
  3114. PROCEDURE TStaticText.ImageText(text: Ptr;
  3115.                                 Length: LONGINT;
  3116.                                 box: Rect;
  3117.                                 just: INTEGER);
  3118.  
  3119.     BEGIN
  3120.     MATextBox(text, Length, box, just, fAutoWrap, NIL, kNoEraseFirst, kSpaceForCaret);
  3121.     END;
  3122.  
  3123. {--------------------------------------------------------------------------------------------------}
  3124. {$S DlgNonRes}
  3125.  
  3126. PROCEDURE TStaticText.ReleaseText;
  3127.  
  3128.     BEGIN
  3129.     Handle(fDataHandle) := DisposeIfHandle(fDataHandle);
  3130.  
  3131.     fRsrcID := kNoResource;
  3132.     END;
  3133.  
  3134. {--------------------------------------------------------------------------------------------------}
  3135. {$S DlgNonRes}
  3136.  
  3137. PROCEDURE TStaticText.SetJustification(theJust: INTEGER;
  3138.                                        redraw: BOOLEAN);
  3139.  
  3140.     BEGIN
  3141.     fJust := theJust;
  3142.     IF redraw THEN
  3143.         ForceRedraw;
  3144.     END;
  3145.  
  3146. {--------------------------------------------------------------------------------------------------}
  3147. {$S DlgNonRes}
  3148.  
  3149. PROCEDURE TStaticText.SetText(theText: Str255;
  3150.                               redraw: BOOLEAN);
  3151.  
  3152.     VAR
  3153.         area:                Rect;
  3154.  
  3155.     BEGIN
  3156.     IF (fDataHandle = NIL) | (theText <> fDataHandle^^) THEN
  3157.         BEGIN
  3158.         ReleaseText;
  3159.         fDataHandle := NewString(theText);
  3160.         IF MemError <> noErr THEN
  3161.             fDataHandle := NIL;
  3162.         IF redraw & Focus & IsVisible THEN
  3163.             BEGIN
  3164.             ControlArea(area);
  3165.             EraseRect(area);
  3166.             Draw(area);
  3167.             END;
  3168.         END;
  3169.     END;
  3170.  
  3171. {--------------------------------------------------------------------------------------------------}
  3172. {$S DlgFields}
  3173.  
  3174. PROCEDURE TStaticText.Fields(PROCEDURE DoToField(fieldName: Str255;
  3175.                                                  fieldAddr: Ptr;
  3176.                                                  fieldType: INTEGER)); OVERRIDE;
  3177.  
  3178.     VAR
  3179.         aString:            Str255;
  3180.  
  3181.     BEGIN
  3182.     DoToField('TStaticText', NIL, bClass);
  3183.     DoToField('fRsrcID', @fRsrcID, bInteger);
  3184.     DoToField('fIndex', @fIndex, bInteger);
  3185.     DoToField('fDataHandle', @fDataHandle, bHandle);
  3186.     IF fDataHandle <> NIL THEN
  3187.         BEGIN
  3188.         aString := fDataHandle^^;
  3189.         DoToField('fDataHandle^^', @aString, bString);
  3190.         END;
  3191.     DoToField('fJust', @fJust, bInteger);
  3192.     DoToField('fAutoWrap', @fAutoWrap, bBoolean);
  3193.  
  3194.     INHERITED Fields(DoToField);
  3195.     END;
  3196.  
  3197. {--------------------------------------------------------------------------------------------------}
  3198. {$S DlgOpen}
  3199.  
  3200. PROCEDURE TEditText.IEditText(itsSuperView: TView;
  3201.                               itsLocation, itsSize: VPoint;
  3202.                               itsMaxChars: INTEGER);
  3203.  
  3204.     BEGIN
  3205.     fTEView := NIL;
  3206.     IStaticText(itsSuperView, itsLocation, itsSize, sizeFixed, sizeFixed, kNoResource, 0);
  3207.  
  3208.     fAutoWrap := FALSE;                                    { Default to compatibility with 2.0
  3209.                                                         Never the twain shall meet.}
  3210.     fMaxChars := itsMaxChars;
  3211.     fControlChars := [chLeft, chRight, chUp, chDown, chBackspace];
  3212.     fTextStyle := gSystemStyle;
  3213.     Inset(3, 3, kDontRedraw);                            { Default is a little, teeny inset… }
  3214.     fPenSize := Point($00010001);                        { …and a thin frame }
  3215.     fAdornment := kFrame;
  3216.     ViewEnable(TRUE, kDontRedraw);
  3217.     fDefChoice := mEditTextHit;
  3218.     END;
  3219.  
  3220. {--------------------------------------------------------------------------------------------------}
  3221. {$S DlgOpen}
  3222.  
  3223. PROCEDURE TEditText.IRes(itsDocument: TDocument;
  3224.                          itsSuperView: TView;
  3225.                          VAR itsParams: Ptr); OVERRIDE;
  3226.  
  3227.     BEGIN
  3228.     fTEView := NIL;
  3229.     INHERITED IRes(NIL, itsSuperView, itsParams);
  3230.  
  3231.     fAutoWrap := FALSE;                                    { Default to compatibility with 2.0
  3232.                                                         Never the twain shall meet.}
  3233.     WITH EditTextTemplatePtr(itsParams)^ DO
  3234.         BEGIN
  3235.         fMaxChars := maxChars;
  3236.         fControlChars := controlChars;
  3237.         END;
  3238.     fDefChoice := mEditTextHit;
  3239.  
  3240.     OffsetPtr(itsParams, SIZEOF(EditTextTemplate));
  3241.     END;
  3242.  
  3243. {--------------------------------------------------------------------------------------------------}
  3244. {$S DlgClose}
  3245.  
  3246. PROCEDURE TEditText.Free; OVERRIDE;
  3247.  
  3248.     BEGIN
  3249.     IF fTEView <> NIL THEN
  3250.         BEGIN
  3251.         fTEView.InstallEditText(NIL, False);
  3252.         fTEView := NIL
  3253.         END;
  3254.  
  3255.     INHERITED Free;
  3256.     END;
  3257.  
  3258. {--------------------------------------------------------------------------------------------------}
  3259. {$S MAWriteRes}
  3260.  
  3261. PROCEDURE TEditText.WRes(theResource: ViewRsrcHndl;
  3262.                          VAR itsParams: Ptr); OVERRIDE;
  3263.  
  3264.     VAR
  3265.         edPtr:                EditTextTemplatePtr;
  3266.  
  3267.     BEGIN
  3268.     INHERITED WRes(theResource, itsParams);
  3269.  
  3270.     edPtr := EditTextTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(EditTextTemplate)));
  3271.  
  3272.     WITH edPtr^ DO
  3273.         BEGIN
  3274.         maxChars := fMaxChars;
  3275.         controlChars := fControlChars;
  3276.         END;
  3277.     END;
  3278.  
  3279. {--------------------------------------------------------------------------------------------------}
  3280. {$S MAWriteRes}
  3281.  
  3282. PROCEDURE TEditText.WriteRes(theResource: ViewRsrcHndl;
  3283.                              VAR itsParams: Ptr); OVERRIDE;
  3284.  
  3285.     BEGIN
  3286.     gWResSignature := 'edit'; gWResType := 'TEditText';
  3287.     WRes(theResource, itsParams);
  3288.     END;
  3289.  
  3290. {--------------------------------------------------------------------------------------------------}
  3291. {$S DlgRes}
  3292.  
  3293. PROCEDURE TEditText.ChangeWrap(newAutoWrap, redraw: BOOLEAN); OVERRIDE;
  3294.  
  3295.     BEGIN
  3296.     INHERITED ChangeWrap(newAutoWrap, redraw);
  3297.     IF fTEView <> NIL THEN
  3298.         fTEView.ChangeWrap(newAutoWrap, redraw)
  3299.     END;
  3300.  
  3301. {--------------------------------------------------------------------------------------------------}
  3302. {$S DlgRes}
  3303.  
  3304. FUNCTION TEditText.HandleMouseDown(theMouse: VPoint;
  3305.                                VAR info: EventInfo;
  3306.                                VAR hysteresis: Point;
  3307.                                VAR theCommand: TCommand): BOOLEAN; OVERRIDE;
  3308.  
  3309.     BEGIN
  3310.     IF IsViewEnabled & (gTarget <> fTEView) THEN    { Get the floating TE installed if necessary }
  3311.         DoChoice(SELF, fDefChoice);
  3312.  
  3313.     HandleMouseDown := INHERITED HandleMouseDown(theMouse, info, hysteresis, theCommand);
  3314.     END;
  3315.  
  3316. {--------------------------------------------------------------------------------------------------}
  3317. {$S DlgRes}
  3318.  
  3319. PROCEDURE TEditText.DoSubstitution(VAR theText: Str255); OVERRIDE;
  3320.  
  3321.     BEGIN
  3322.     { Default action is for editable text items is not to do any substitions }
  3323.     END;
  3324.  
  3325. {--------------------------------------------------------------------------------------------------}
  3326. {$S DlgRes}
  3327.  
  3328. PROCEDURE TEditText.Draw(area: Rect); OVERRIDE;
  3329.  
  3330.     VAR
  3331.         theRect:            Rect;
  3332.  
  3333.     BEGIN
  3334.     IF fTEView <> NIL THEN
  3335.         BEGIN
  3336.         GetQDExtent(theRect);
  3337.         Adorn(theRect, fPenSize, fAdornment);
  3338.         END
  3339.     ELSE
  3340.         INHERITED Draw(area);
  3341.     END;
  3342.  
  3343. {--------------------------------------------------------------------------------------------------}
  3344. {$S DlgFields}
  3345.  
  3346. PROCEDURE TEditText.Fields(PROCEDURE DoToField(fieldName: Str255;
  3347.                                                fieldAddr: Ptr;
  3348.                                                fieldType: INTEGER)); OVERRIDE;
  3349.  
  3350.     BEGIN
  3351.     DoToField('TEditText', NIL, bClass);
  3352.     DoToField('fMaxChars', @fMaxChars, bInteger);
  3353.     DoToField('fTEView', @fTEView, bObject);
  3354.     DoToField('fControlChars', @fControlChars, bHexLongInt);
  3355.  
  3356.     INHERITED Fields(DoToField);
  3357.     END;
  3358.  
  3359. {--------------------------------------------------------------------------------------------------}
  3360. {$S DlgRes}
  3361.  
  3362. PROCEDURE TEditText.GetText(VAR theText: Str255); OVERRIDE;
  3363.  
  3364.     VAR
  3365.         theChars:            Handle;
  3366.         numberOfChars:        INTEGER;
  3367.  
  3368.     BEGIN
  3369.     IF fTEView = NIL THEN
  3370.         INHERITED GetText(theText)
  3371.     ELSE
  3372.         BEGIN
  3373.         theChars := fTEView.ExtractText;
  3374.         numberOfChars := MIN(255, GetHandleSize(theChars));
  3375.         {$Push} {$R-}
  3376.         theText[0] := CHR(numberOfChars);
  3377.         {$Pop}
  3378.         BlockMove(Ptr(theChars^), Ptr(ORD4(@theText) + 1), numberOfChars);
  3379.         END;
  3380.     END;
  3381.  
  3382. {--------------------------------------------------------------------------------------------------}
  3383.  
  3384. PROCEDURE TEditText.ImageText(text: Ptr;
  3385.                               Length: LONGINT;
  3386.                               box: Rect;
  3387.                               just: INTEGER); OVERRIDE;
  3388.  
  3389.     BEGIN
  3390.     IF Length >= 0 THEN
  3391.         MATextBox(text, Length, box, just, fAutoWrap , NIL, kNoEraseFirst,
  3392.         kSpaceForCaret);
  3393.     END;
  3394.  
  3395. {--------------------------------------------------------------------------------------------------}
  3396. {$S DlgNonRes}
  3397.  
  3398. PROCEDURE TEditText.RestartEdit(restartText: Str255);
  3399.  
  3400.     VAR
  3401.         area:                Rect;
  3402.  
  3403.     BEGIN
  3404.     IF fTEView.Focus THEN                                { First, attempt to focus the TEView }
  3405.         BEGIN
  3406.         ClipRect(gZeroRect);                            { Prevent TE from mucking up the hilite with
  3407.                                                          a stinking insertion point }
  3408.  
  3409.         InstallSelection(TRUE, False);                    { Deactivate the selection }
  3410.         SetText(restartText, kDontRedraw);                { Set the text to previous value }
  3411.         SetSelection(0, MAXINT, kDontRedraw);            { Select all characters }
  3412.  
  3413.         InstallSelection(False, TRUE);                    { Activate the selection }
  3414.         InvalidateFocus;                                { Make sure we re-focus }
  3415.         fTEView.ForceRedraw;
  3416.         END
  3417.     ELSE
  3418.         SetText(restartText, kDontRedraw);                { Just set the text if we can't focus }
  3419.     END;
  3420.  
  3421. {--------------------------------------------------------------------------------------------------}
  3422. {$S DlgNonRes}
  3423.  
  3424. PROCEDURE TEditText.SetJustification(theJust: INTEGER;
  3425.                                      redraw: BOOLEAN);
  3426.  
  3427.     BEGIN
  3428.     IF fTEView <> NIL THEN
  3429.         fTEView.SetJustification(theJust, redraw);
  3430.     INHERITED SetJustification(theJust, redraw);
  3431.     END;
  3432.  
  3433. {--------------------------------------------------------------------------------------------------}
  3434. {$S DlgRes}
  3435.  
  3436. PROCEDURE TEditText.SetSelection(selStart, selEnd: INTEGER;
  3437.                                  redraw: BOOLEAN);
  3438.  
  3439.     BEGIN
  3440.     IF fTEView <> NIL THEN
  3441.         BEGIN
  3442.         IF redraw & fTEView.Focus & fTEView.IsVisible THEN
  3443.             BEGIN
  3444.             TESetSelect(selStart, selEnd, fTEView.fHTE);
  3445.             END
  3446.         ELSE
  3447.             SetSelect(selStart, selEnd, fTEView.fHTE);
  3448.         END;
  3449.     END;
  3450.  
  3451. {--------------------------------------------------------------------------------------------------}
  3452. {$S DlgNonRes}
  3453.  
  3454. PROCEDURE TEditText.SetText(theText: Str255;
  3455.                             redraw: BOOLEAN); OVERRIDE;
  3456.  
  3457.     VAR
  3458.         currentText:        Str255;
  3459.         area:                Rect;
  3460.  
  3461.     BEGIN
  3462.     IF fTEView <> NIL THEN
  3463.         BEGIN
  3464.         GetText(currentText);
  3465.         IF currentText <> theText THEN
  3466.             BEGIN
  3467.             fTEView.SetText(theText);
  3468.             fTEView.RecalcText;
  3469.             fTEView.SynchView(kDontRedraw);
  3470.             IF redraw & Focus & IsVisible THEN
  3471.                 BEGIN
  3472.                 ControlArea(area);
  3473.                 EraseRect(area);
  3474.                 DrawContents;
  3475.                 END;
  3476.             END;
  3477.         END
  3478.     ELSE
  3479.         INHERITED SetText(theText, redraw);
  3480.     END;
  3481.  
  3482. {--------------------------------------------------------------------------------------------------}
  3483. {$S DlgRes}
  3484.  
  3485. PROCEDURE TEditText.InstallSelection(wasActive, beActive: BOOLEAN); OVERRIDE;
  3486.  
  3487.     BEGIN
  3488.     IF fTEView <> NIL THEN
  3489.         fTEView.InstallSelection(wasActive, beActive);
  3490.     END;
  3491.  
  3492. {--------------------------------------------------------------------------------------------------}
  3493. {$S DlgNonRes}
  3494.  
  3495. PROCEDURE TEditText.StartEdit(selectChars: BOOLEAN;
  3496.                               theTEView: TDialogTEView);
  3497.  
  3498.     VAR
  3499.         myExtent:            VRect;
  3500.         minToSee:            Point;
  3501.         itsWindow:            TWindow;
  3502.  
  3503.     BEGIN
  3504.     IF theTEView = NIL THEN
  3505.         BEGIN
  3506.         {$IFC qDebug}
  3507.         ProgramBreak('the TEView is nil.');
  3508.         {$ENDC}
  3509.         EXIT(StartEdit);
  3510.         END;
  3511.  
  3512.     theTEView.InstallEditText(SELF, selectChars);
  3513.     fTEView := theTEView;
  3514.     itsWindow := GetWindow;                             { Set the window's target, which sets }
  3515.     IF itsWindow <> NIL THEN                            { …the application's target if it is }
  3516.         itsWindow.SetTarget(theTEView);                 { …the front window. }
  3517.  
  3518.     GetExtent(myExtent);
  3519.     InsetVRect(myExtent, - 10, - 10);
  3520.     minToSee.h := MIN(fSize.h + 10, kMaxCoord);
  3521.     minToSee.v := MIN(fSize.v + 10, kMaxCoord);
  3522.  
  3523.     RevealRect(myExtent, minToSee, kVisible);            { Make me visible }
  3524.     END;
  3525.  
  3526. {--------------------------------------------------------------------------------------------------}
  3527. {$S DlgNonRes}
  3528.  
  3529. PROCEDURE TEditText.StopEdit;
  3530.  
  3531.     VAR
  3532.         aString:            Str255;
  3533.  
  3534.     BEGIN
  3535.     IF fTEView <> NIL THEN
  3536.         BEGIN
  3537.         GetText(aString);                                { Must get the text before calling
  3538.                                                          InstallEditText }
  3539.         fTEView.InstallSelection(TRUE, False);
  3540.         fTEView.InstallEditText(NIL, False);
  3541.         fTEView := NIL;
  3542.         SetText(aString, kDontRedraw);
  3543.         END;
  3544.     END;
  3545.  
  3546. {--------------------------------------------------------------------------------------------------}
  3547. {$S DlgRes}
  3548.  
  3549. FUNCTION TEditText.Validate: LONGINT;
  3550.  
  3551.     VAR
  3552.         validateResult:     LONGINT;
  3553.  
  3554.     BEGIN
  3555.     validateResult := INHERITED Validate;
  3556.     IF (validateResult = kValidValue) & (fTEView <> NIL) & (GetHandleSize(fTEView.fText) >
  3557.        fMaxChars) THEN
  3558.         validateResult := kTooManyCharacters;
  3559.     Validate := validateResult;
  3560.     END;
  3561.  
  3562. {--------------------------------------------------------------------------------------------------}
  3563. {$S DlgOpen}
  3564.  
  3565. PROCEDURE TNumberText.INumberText(itsSuperView: TView;
  3566.                                   itsLocation, itsSize: VPoint;
  3567.                                   itsValue, itsMinimum, itsMaximum: LONGINT);
  3568.  
  3569.     VAR
  3570.         aString:            Str255;
  3571.  
  3572.     BEGIN
  3573.     IEditText(itsSuperView, itsLocation, itsSize, 255);
  3574.     {$IFC qDebug}
  3575.     IF itsMinimum > itsMaximum THEN
  3576.         WRITELN('Minimum value specified is greater than maximum for TNumberText.');
  3577.     {$ENDC}
  3578.     fMinimum := itsMinimum;
  3579.     fMaximum := itsMaximum;
  3580.     NumToString(itsValue, aString);
  3581.     SetText(aString, kDontRedraw);
  3582.     END;
  3583.  
  3584. {--------------------------------------------------------------------------------------------------}
  3585. {$S DlgOpen}
  3586.  
  3587. PROCEDURE TNumberText.IRes(itsDocument: TDocument;
  3588.                            itsSuperView: TView;
  3589.                            VAR itsParams: Ptr); OVERRIDE;
  3590.  
  3591.     VAR
  3592.         aString:            Str255;
  3593.  
  3594.     BEGIN
  3595.     INHERITED IRes(NIL, itsSuperView, itsParams);
  3596.  
  3597.     WITH NumberTextTemplatePtr(itsParams)^ DO
  3598.         BEGIN
  3599.         NumToString(value, aString);
  3600.         SetText(aString, kDontRedraw);
  3601.         {$IFC qDebug}
  3602.         IF minimum > maximum THEN
  3603.             WRITELN('Minimum value specified is greater than maximum for TNumberText.');
  3604.         {$ENDC}
  3605.         fMinimum := minimum;
  3606.         fMaximum := maximum;
  3607.         END;
  3608.  
  3609.     OffsetPtr(itsParams, SIZEOF(NumberTextTemplate));
  3610.     END;
  3611.  
  3612. {--------------------------------------------------------------------------------------------------}
  3613. {$S MAWriteRes}
  3614.  
  3615. PROCEDURE TNumberText.WRes(theResource: ViewRsrcHndl;
  3616.                            VAR itsParams: Ptr); OVERRIDE;
  3617.  
  3618.     VAR
  3619.         nmPtr:                NumberTextTemplatePtr;
  3620.  
  3621.     BEGIN
  3622.     INHERITED WRes(theResource, itsParams);
  3623.  
  3624.     nmPtr := NumberTextTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(NumberTextTemplate)));
  3625.  
  3626.     WITH nmPtr^ DO
  3627.         BEGIN
  3628.         value := GetValue;
  3629.         minimum := fMinimum;
  3630.         maximum := fMaximum;
  3631.         END;
  3632.     END;
  3633.  
  3634. {--------------------------------------------------------------------------------------------------}
  3635. {$S MAWriteRes}
  3636.  
  3637. PROCEDURE TNumberText.WriteRes(theResource: ViewRsrcHndl;
  3638.                                VAR itsParams: Ptr); OVERRIDE;
  3639.  
  3640.     BEGIN
  3641.     gWResSignature := 'nmbr'; gWResType := 'TNumberText';
  3642.     WRes(theResource, itsParams);
  3643.     END;
  3644.  
  3645. {--------------------------------------------------------------------------------------------------}
  3646. {$S DlgRes}
  3647.  
  3648. FUNCTION TNumberText.GetValue: LONGINT;
  3649.  
  3650.     VAR
  3651.         aString:            Str255;
  3652.         theValue:            LONGINT;
  3653.  
  3654.     BEGIN
  3655.     GetText(aString);
  3656.     StringToNum(aString, theValue);
  3657.     GetValue := theValue;
  3658.     END;
  3659.  
  3660. {--------------------------------------------------------------------------------------------------}
  3661. {$S DlgNonRes}
  3662.  
  3663. PROCEDURE TNumberText.SetValue(newValue: LONGINT;
  3664.                                redraw: BOOLEAN);
  3665.  
  3666.     VAR
  3667.         aString:            Str255;
  3668.  
  3669.     BEGIN
  3670.     newValue := Max(fMinimum, MIN(fMaximum, newValue));
  3671.     NumToString(newValue, aString);
  3672.     SetText(aString, redraw);
  3673.     END;
  3674.  
  3675. {--------------------------------------------------------------------------------------------------}
  3676. {$S DlgNonRes}
  3677.  
  3678. FUNCTION TNumberText.Validate: LONGINT; OVERRIDE;
  3679.  
  3680.     VAR
  3681.         theString:            Str255;
  3682.         decRec:             Decimal;
  3683.         extValue:            Extended;
  3684.         index:                INTEGER;
  3685.         validPrefix:        BOOLEAN;
  3686.  
  3687.     BEGIN
  3688.     Validate := kValidValue;
  3689.  
  3690.     {!!! This really begs for a fRequired field to test when the string is left empty }
  3691.     { Then we would inform the user that an empty string is not a valid option. }
  3692.     { Also a fDefault field is necessary. GetValue would return fDefault rather }
  3693.     { than 0 when the string is empty.    For now (2.0) we will not validate an empty
  3694.     { string and assume that if the user wants a value they will override. }
  3695.  
  3696.     GetText(theString);
  3697.     IF theString <> '' THEN
  3698.         BEGIN
  3699.         index := 1;
  3700.         Str2Dec(theString, index, decRec, validPrefix);
  3701.         IF validPrefix & (index > Length(theString)) & (decRec.exp >= 0) THEN
  3702.             BEGIN
  3703.             extValue := Dec2Num(decRec);
  3704.             IF extValue < fMinimum THEN
  3705.                 Validate := kValueTooSmall
  3706.             ELSE IF extValue > fMaximum THEN
  3707.                 Validate := kValueTooLarge;
  3708.             END
  3709.         ELSE
  3710.             Validate := kNonNumericCharacters;
  3711.         END;
  3712.     END;
  3713.  
  3714. {--------------------------------------------------------------------------------------------------}
  3715. {$S DlgFields}
  3716.  
  3717. PROCEDURE TNumberText.Fields(PROCEDURE DoToField(fieldName: Str255;
  3718.                                                  fieldAddr: Ptr;
  3719.                                                  fieldType: INTEGER)); OVERRIDE;
  3720.  
  3721.     BEGIN
  3722.     DoToField('TNumberText', NIL, bClass);
  3723.     DoToField('fMinimum', @fMinimum, bLongInt);
  3724.     DoToField('fMaximum', @fMaximum, bLongInt);
  3725.  
  3726.     INHERITED Fields(DoToField);
  3727.     END;
  3728.